Option Explicit
Option Base 0
Public Sub 表データシャッフルマクロ()
Dim Ip As Integer, Jp As Integer, strDat As String
Dim celData As Cell, rngData As Range
Dim strTblDt() As String, intShuDt() As Integer
Dim intShuTp(1) As Integer
If ActiveDocument.Tables.Count < 1 Then Exit Sub
'
With ActiveDocument.Tables(1)
ReDim strTblDt(.Rows.Count - 1, .Columns.Count - 1)
ReDim intShuDt(.Rows.Count - 1, 1)
'
'*セルデータ取り込み
For Each celData In .Range.Cells
strDat = celData.Range.Text
strTblDt(celData.RowIndex - 1, celData.ColumnIndex - 1) = _
Left(strDat, Len(strDat) - 2)
Next celData
'
Randomize '乱数初期化
For Ip = 0 To .Rows.Count - 1
intShuDt(Ip, 0) = Ip: intShuDt(Ip, 1) = CInt(Rnd * 1000 + 1)
Next Ip
intShuDt(0, 1) = 0
'*シャッフル処理（実は乱数データをソート）
For Ip = LBound(intShuDt, 1) + 1 To UBound(intShuDt, 1)
intShuTp(0) = intShuDt(Ip, 0): intShuTp(1) = intShuDt(Ip, 1)
If intShuDt(Ip - 1, 1) > intShuTp(1) Then
Jp = Ip
Do While Jp > LBound(intShuDt, 1)
If intShuDt(Jp - 1, 1) <= intShuTp(1) Then Exit Do
intShuDt(Jp - 0, 0) = intShuDt(Jp - 1, 0)
intShuDt(Jp - 0, 1) = intShuDt(Jp - 1, 1)
Jp = Jp - 1
Loop
intShuDt(Jp, 0) = intShuTp(0)
intShuDt(Jp, 1) = intShuTp(1)
End If
Next Ip
*シャフルした結果順にセルデータをセット
For Each celData In .Range.Cells
strDat = celData.Range.Text
Ip = celData.RowIndex - 1: Jp = celData.ColumnIndex - 1
celData.Range.Text = strTblDt(intShuDt(Ip, 0), Jp)
Next celData
End With
End Sub
蛇足
実際、わざわざ、マクロを作ってすることもないだろうが、僕は、中国の思想家、老子の「無用の用」という言葉が好きだから、作ってみた。
