Question

我在Excel工作表中有一个数据集，我需要将这个（例如999个记录）随机分成3个相同（并且没有重复）的Excel文件。这可以简单地通过使用一些Excel函数来完成，或者我需要编写代码来专门执行此操作吗？

Answer 1

有时候低技术是最好的。如果你不经常重复这个......

向数据集添加一列，填入=RAND()
对此列中的数据集进行排序
将前333行复制到新工作表中
将接下来的333行复制到新工作表中

我敢打赌，花费的时间比您已经花费的时间更少。

Answer 2

此修订后的宏将采用原始的 999 记录，并将其随机分发到其他三个文件（每个文件包含333个项目）：

Sub croupier()
    Dim k1 As Long, k2 As Long, k3 As Long
    Dim Original As Workbook
    Dim I As Long, ary(1 To 999)
    Set Original = ActiveWorkbook
    Dim rw As Long

    Workbooks.Add
    Set Winken = ActiveWorkbook
    Workbooks.Add
    Set Blinken = ActiveWorkbook
    Workbooks.Add
    Set Nod = ActiveWorkbook
    k1 = 1
    k2 = 1
    k3 = 1
    For I = 1 To 999
        ary(I) = I
    Next I

    Call Shuffle(ary)

    With Original.Sheets("Sheet1")
    For I = 1 To 333
        rw = ary(I)
        .Cells(rw, 1).EntireRow.Copy Winken.Sheets("Sheet1").Cells(k1, 1)
        k1 = k1 + 1
    Next I
    For I = 334 To 666
        rw = ary(I)
        .Cells(rw, 1).EntireRow.Copy Blinken.Sheets("Sheet1").Cells(k2, 1)
        k2 = k2 + 1
    Next I
    For I = 667 To 999
        rw = ary(I)
        .Cells(rw, 1).EntireRow.Copy Nod.Sheets("Sheet1").Cells(k3, 1)
        k3 = k3 + 1
    Next I
    End With

    Winken.Save
    Blinken.Save
    Nod.Save
    Winken.Close
    Blinken.Close
    Nod.Close

End Sub


Sub Shuffle(InOut() As Variant)
    Dim HowMany As Long, I As Long, J As Long
    Dim tempF As Double, temp As Variant

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim Helper(Low To Hi) As Double
    Randomize

    For I = Low To Hi
        Helper(I) = Rnd
    Next I


    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For I = Low To Hi - J
          If Helper(I) > Helper(I + J) Then
            tempF = Helper(I)
            Helper(I) = Helper(I + J)
            Helper(I + J) = tempF
            temp = InOut(I)
            InOut(I) = InOut(I + J)
            InOut(I + J) = temp
          End If
        Next I
        For I = Hi - J To Low Step -1
          If Helper(I) > Helper(I + J) Then
            tempF = Helper(I)
            Helper(I) = Helper(I + J)
            Helper(I + J) = tempF
            temp = InOut(I)
            InOut(I) = InOut(I + J)
            InOut(I + J) = temp
          End If
        Next I
        J = J \ 2
    Loop
End Sub

Answer 3

这是一个接受数组并复制到三个不同工作表的宏：

Sub DoWork(Students As Variant)

Dim i As Long
Dim row As Integer
Dim sheetNumber As Integer
ReDim myArray(UBound(Students)) As Variant
Dim shuffledArray As Variant
Dim wkSheet As Worksheet
Dim myBooks(3) As Workbook

Set myBooks(1) = workBooks.Add
Set myBooks(2) = workBooks.Add
Set myBooks(3) = workBooks.Add

'populate the array with the number of rows
For i = 1 To UBound(Students)
    myArray(i) = i
Next

'shuffle the array to provide true randomness
shuffledArray = ShuffleArray(myArray)

sheetNumber = 1
row = 1

'loop through the rows assiging to sheets
For i = 1 To UBound(Students)

    If sheetNumber = 4 Then
        sheetNumber = 1
        row = row + 1
    End If

    Set wkSheet = myBooks(sheetNumber).ActiveSheet

    wkSheet.Cells(row, 1) = Students(shuffledArray(i))

    sheetNumber = sheetNumber + 1

Next

myBooks(1).SaveAs ("ws1.xlsx")
myBooks(2).SaveAs ("ws2.xlsx")
myBooks(3).SaveAs ("ws3.xlsx")

End Sub

Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim Temp As Variant
    Dim J As Long
    Dim Arr() As Variant
    Dim L As Long


    Randomize
    L = UBound(InArray) - LBound(InArray) + 1
    ReDim Arr(LBound(InArray) To UBound(InArray))
    For N = LBound(InArray) To UBound(InArray)
        Arr(N) = InArray(N)
    Next N
    For N = LBound(Arr) To UBound(Arr)
        J = CLng(((UBound(Arr) - N) * Rnd) + N)
        Temp = Arr(N)
        Arr(N) = Arr(J)
        Arr(J) = Temp
    Next N
    ShuffleArray = Arr
End Function

Sub ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim L As Long
    Dim Temp As Variant
    Dim J As Long

    Randomize
    L = UBound(InArray) - LBound(InArray) + 1
    For N = LBound(InArray) To UBound(InArray)
        J = CLng(((UBound(InArray) - N) * Rnd) + N)
        If N <> J Then
            Temp = InArray(N)
            InArray(N) = InArray(J)
            InArray(J) = Temp
        End If
    Next N
End Sub

然后你会用这样的话打电话：

Option Explicit
Option Base 1

Sub Test()

Dim i As Long

Dim Students(999) As Variant

'populate the array with the number of rows
For i = 1 To UBound(Students)
    Students(i) = "Students-" & Str(i)
Next

DoWork (Students)

End Sub

随机将数据拆分为3个部分 - Excel

3 个答案: