请老师用VBA,把E列数复制到F列并随机打乱，谢谢！

沈默00

还是改一下吧，有重复的也可以

hcm19522

C2下拉=IF(B2="","",INDEX(B:B,SMALL(IF((COUNTIF(C$1:C1,B$2:B$99)=0)*(B$2:B$99<>""),ROW($2:$99)),RANDBETWEEN(1,COUNTA(B:B)-ROW(A1)))))

E2=SUMPRODUCT(COUNTIF(B:B,C2:C99)*(C2:C99<>""))=COUNTA(B:B)-1

yes_cn

Sub CopyAndShuffle()
    Dim lastRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim tempArr() As Variant
    Dim i As Long, j As Long
    Dim temp As Variant
   
    '找到E列的最后一行
    lastRow = Cells(Rows.Count, 5).End(xlUp).Row
   
    '将E列的数值复制到F列
    Range("E1:E" & lastRow).Copy Destination:=Range("F1:F" & lastRow)
   
    '将F列的数值放入数组
    Set rng = Range("F1:F" & lastRow)
    tempArr = rng.Value
   
    'Fisher-Yates shuffle算法随机打乱数组
    For i = UBound(tempArr, 1) To LBound(tempArr, 1) Step -1
        j = Int((i - LBound(tempArr, 1) + 1) * Rnd + LBound(tempArr, 1))
        temp = tempArr(i, 1)
        tempArr(i, 1) = tempArr(j, 1)
        tempArr(j, 1) = temp
    Next i
   
    '将打乱后的数组值写回F列
    rng.Value = tempArr
End Sub




===========================================
选择 CopyAndShuffle 宏并运行。

gwjkkkkk

Option Explicit
Sub test1()
    Dim ar
   
    ar = [E1].CurrentRegion.Value
    arrGetRnd1 ar
    [G1].Resize(UBound(ar)) = ar

    Beep
End Sub
Function arrGetRnd1(ByRef ar)
    Dim xNum&, i&, n&, vTemp
    Randomize
    n = UBound(ar)
    For i = 1 To UBound(ar)
        xNum = Int((n - i + 1) * Rnd() + i)
        vTemp = ar(xNum, 1): ar(xNum, 1) = ar(i, 1): ar(i, 1) = vTemp
    Next
End Function

gwjkkkkk

。。。。。。。。。。

一招秒杀

当你用第3代码语言要挖空心思设计算法，费尽心机，伤透脑筋，编写调试好几十行代码，第4代语言可能 小半句就够了，只需要 Order By NewID()  就已经完美解决了，还有谁能更简单。
第4代语言，让你远离基础技术代码，眼光聚焦于业务逻辑，更高效解决现实问题。

779846526

一招秒杀 发表于 2024-6-27 21:29
当你用第3代码语言要挖空心思设计算法，费尽心机，伤透脑筋，编写调试好几十行代码，第4代语言可能 小半句 ...

秒杀哥，看看这个问题能不能秒杀吧https://club.excelhome.net/threa ... tml?_dsign=b4004a93

准提部林

隨機打亂//大搬風.全動..by.准提部林

Sub Test_A1()
Dim Arr, i&, V&, T
Randomize
Arr = Range([e1], [e65536].End(3))
For i = UBound(Arr) - 1 To 1 Step -1
    V = Int(Rnd * i) + 1
    T = Arr(i + 1, 1)
    Arr(i + 1, 1) = Arr(V, 1)
    Arr(V, 1) = T
Next i
[f1].Resize(UBound(Arr)) = Arr
End Sub