VBA从不同的工作簿复制指定的随机数据

Sub getdata() 'CTRL+J Windows("sample rnd.xlsm").Activate Range("A1:L5215").Select Range("A2").Activate Selection.Copy Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False Selection.Copy Windows("rnd sample draft.xlsm").Activate Sheets("Random Sample").Select Sheets("Random Sample").Name = "Random Sample" Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.Save End Sub 

以上是我的代码到目前为止。 它只是从另一个工作簿复制数据并粘贴到我指定的工作表中。

我想要的是随机数据（行）没有重复，我总是想包括第一行，因为它包含标题。

此外，我想有一个文本框，我可以input数字，以便我可以指定从另一个工作簿中获得多less数据。 相当新的vba。 需要帮忙。

我附上了一个截图。

Answer 1

一种解决scheme是加载数组中的行，混合行并将数组写入目标：

 Sub CopyRandomRows() Dim source As Range, target As Range, randCount&, data(), value, r&, rr&, c& ' define the source to take the data Set source = Workbooks("CheckSum3.xlsm").Worksheets("Sheet17").Range("$A$1:$B$10") ' define the target to paste the data Set target = Workbooks("rnd sample draft.xlsm").Worksheets("Random Sample").Range("A1") ' define the number of rows to generate randCount = 5 ' load the data in an array data = source.value 'shuffle the rows For r = 1 To randCount rr = 1 + Math.Round(VBA.Rnd * (UBound(data) - 1)) For c = 1 To UBound(data, 2) value = data(r, c) data(r, c) = data(rr, c) data(rr, c) = value Next Next ' write the data to the target target.Resize(randCount, UBound(data, 2)) = data End Sub 

Answer 2

一个“不那么聪明”的做法就是这样的：

 Sub Macro1(numRows As Long) Dim a As Long, i As Long, rng As Range Windows("sample rnd.xlsm").Activate a = Int(Rnd() * 5213) + 2 Set rng = Range("A1:L1") For i = 1 To numRows While Not Intersect(Cells(a, 1), rng) Is Nothing a = Int(Rnd() * 5213) + 2 Wend Set rng = Union(rng, Range("A1:L5215").Rows(a)) Next rng.Copy Sheets("Random Sample").Range("A1").Select ActiveSheet.Paste End Sub 

如果你不想要大量的行…你也可以把所有的行放在一个集合中，然后删除一个随机项，直到计数达到你想要的行数（也不是那么聪明的解决scheme） ：

 Sub Macro2(numRows As Long) Dim a As Long, myCol As New Collection, rng As Range Windows("sample rnd.xlsm").Activate For a = 2 To 5215 myCol.Add a Next While myCol.Count > numRows myCol.Remove Int(Rnd() * myCol.Count) + 1 Wend Set rng = Range("A1:L1") For a = 1 To myCol.Count Set rng = Union(rng, Range("A1:L5215").Rows(myCol(a))) Next rng.Copy Sheets("Random Sample").Range("A1").Select ActiveSheet.Paste End Sub 

如果你仍然有问题，请问;）