将数据随机分成3部分 – Excel

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

Answer 1

有时候低科技是最好的。 如果你不需要经常重复这个…

1. 向数据集添加一列，填入=RAND()
2. sorting该列上的数据集
3. 将第333行复制到新工作表中
4. 将下一个333行复制到一个新的工作表

我敢打赌，花费的时间比已经花费在尝试让macros运行上花费的时间要less。

Answer 2

这个修改后的macros将把原始的999条logging随机分配到其他三个文件（每个文件包含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

这是一个macros将接受一个数组并复制到三个不同的表：

 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