|
- Sub 换位()
- Dim arr, i As Integer, j As Integer
- Dim strTemp As String
- Dim r1 As Integer, c1 As Integer, r2 As Integer, c2 As Integer
- arr = Range("a1").CurrentRegion.Value
- i = Application.InputBox("请输入数据换位的次数[>=2]" & vbCrLf & vbCrLf & "次数越大越好", "提示", 30, , , , , 1)
- If i < 2 Then
- MsgBox "换位数次不对"
- Exit Sub
- End If
- For j = 1 To i
- Do
- r1 = WorksheetFunction.RandBetween(LBound(arr), UBound(arr))
- r2 = WorksheetFunction.RandBetween(LBound(arr), UBound(arr))
- c1 = WorksheetFunction.RandBetween(LBound(arr, 2), UBound(arr, 2))
- c2 = WorksheetFunction.RandBetween(LBound(arr, 2), UBound(arr, 2))
- Loop Until r1 <> r2 Or c1 <> c2
- '条件换成or后,同行不同列或同列不同行也能换位
- '原来条件用AND,要求不同行不同列才能交换
- strTemp = arr(r1, c1)
- arr(r1, c1) = arr(r2, c2)
- arr(r2, c2) = strTemp
- Next
- Range("a1").CurrentRegion.Value = arr
- MsgBox "换位完成"
- End Sub
复制代码 |
|