Option Explicit
Sub test1()
Dim ar, i&, j&, m&, n&, Par As Paragraph, objTable As Table, Rng As Range
Application.ScreenUpdating = False
With ActiveDocument.Tables(1)
m = .Rows.Count: n = .Columns.Count
ReDim ar(1 To m, 1 To n)
For i = 1 To UBound(ar)
For j = 1 To UBound(ar, 2)
ar(i, j) = Left(.Cell(i, j).Range.Text, Len(.Cell(i, j).Range.Text) - 2)
Next j
Next i
arrGetRnd2 ar
For i = 1 To UBound(ar)
For j = 1 To UBound(ar, 2)
.Cell(i, j).Range.Text = ar(i, j)
Next j
Next i
End With
Application.ScreenUpdating = True
Beep
End Sub
Function arrGetRnd2(ByRef ar, Optional ByVal isCol As Boolean)
Dim xNum&, i&, j&, m&, n&, y&, x&, vTemp
Randomize
m = UBound(ar): n = UBound(ar, 2)
If isCol Then
vTemp = m: m = n: n = vTemp
y = LBound(ar, 2): x = LBound(ar)
Else
y = LBound(ar): x = LBound(ar, 2)
End If
For i = y To m - 1
xNum = Int((m - i + 1) * Rnd() + i)
For j = x To n
If isCol Then
vTemp = ar(j, xNum): ar(j, xNum) = ar(j, i): ar(j, i) = vTemp
Else
vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
End If
Next
Next
End Function
|