vba A列为一组、B列为一组、C列为一组随机重组成一列
以下是一个使用VBA重组A、B和C列的示例代码:
Sub RandomReorder()
Dim rngA As Range, rngB As Range, rngC As Range
Dim rngCombined As Range, rngOutput As Range
Dim arrCombined() As Variant
Dim i As Long, j As Long
' 设置要操作的范围
Set rngA = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rngB = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set rngC = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
' 将数据合并到一个数组中
ReDim arrCombined(1 To rngA.Rows.Count + rngB.Rows.Count + rngC.Rows.Count, 1 To 1)
For i = 1 To rngA.Rows.Count
arrCombined(i, 1) = rngA.Cells(i, 1).Value
Next i
For i = 1 To rngB.Rows.Count
arrCombined(rngA.Rows.Count + i, 1) = rngB.Cells(i, 1).Value
Next i
For i = 1 To rngC.Rows.Count
arrCombined(rngA.Rows.Count + rngB.Rows.Count + i, 1) = rngC.Cells(i, 1).Value
Next i
' 随机重排数组
For i = 1 To UBound(arrCombined)
j = Int((UBound(arrCombined) - i + 1) * Rnd + i)
If i <> j Then
Dim temp As Variant
temp = arrCombined(i, 1)
arrCombined(i, 1) = arrCombined(j, 1)
arrCombined(j, 1) = temp
End If
Next i
' 将重排后的数据写回到一列中
Set rngOutput = Range("D1").Resize(UBound(arrCombined), 1)
rngOutput.Value = arrCombined
' 清除原始数据
rngA.ClearContents
rngB.ClearContents
rngC.ClearContents
' 将重排后的数据复制回原始位置
rngOutput.Copy rngA
End Sub
请确保在运行代码之前先备份你的数据。此代码将会清除A、B和C列中的原始数据,并将随机重组后的数据写回到A列中。你可以根据需要修改代码中的范围和输出位置
原文地址: https://www.cveoy.top/t/topic/iFgJ 著作权归作者所有。请勿转载和采集!