Rnd()

選択セル範囲の値をランダムに入れ替える

 選択しているセル範囲の値をランダムに入れ替えるコードを紹介します。数値だけでなく文字列にも対応しています。席替えやグループ決めなどに利用できるかもしれません。


サンプルコード

・セル範囲を選択していないと、マクロは動作しません。
・選択しているセルが単一の場合、マクロは動作しません。

Sub Rand_2() '選択しているセル範囲内の値をランダムに入れ替える

    Dim lngI As Long, lngII As Long
    Dim lngRow As Long, lngCol As Long
    Dim lngRnd As Long, lngRowsC As Long
    Dim lngCount As Long, lngCellsC As Long, lngValue() As Long
    Dim bolFlg() As Boolean
    Dim varData As Variant, varResult() As Variant, varSelection() As Variant

    With Application
        If TypeName(.Selection) <> "Range" Then Exit Sub
        .ScreenUpdating = False
        With .Selection
            If 1 < .Areas.Count Or .Cells.Count = 1 Then Exit Sub
            varResult = .Value
            varSelection = .Value
            lngRowsC = .Rows.Count
            lngCellsC = .Rows.Count * .Columns.Count
            Randomize
            lngCount = 1
            ReDim bolFlg(1 To lngCellsC)
            ReDim varData(1 To lngCellsC)
            ReDim lngValue(1 To lngCellsC)
            Do
                lngRnd = Int(lngCellsC * Rnd()) + 1
                If bolFlg(lngRnd) = False Then
                    bolFlg(lngRnd) = True
                    lngValue(lngCount) = lngRnd
                    lngCount = lngCount + 1
                    If lngCellsC < lngCount Then Exit Do
                End If
            Loop
            lngCount = 0
            For lngI = 1 To .Rows.Count
                For lngII = 1 To .Columns.Count
                    lngCount = lngCount + 1
                    lngRow = ((lngValue(lngCount) - 1) Mod lngRowsC) + 1
                    lngCol = (lngValue(lngCount) + lngRowsC - 1) \ lngRowsC
                    varResult(lngI, lngII) = varSelection(lngRow, lngCol)
                Next
            Next
            .Value = varResult
        End With
        .ScreenUpdating = True
    End With
End Sub

Excel Tips for Teachers

Copyright (C) 2009- 坂江 保 All Rights Reserved.