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
以上是我的代码。它只是从另一个工作簿复制数据并将其粘贴到我指定的工作表。
我想要的是获得没有重复的随机数据(行),并且我总是希望包含第一行,因为它包含标题。
另外,我想有一个文本框,我可以在其中输入数字,以便我可以指定从其他工作簿获取的数据量。 vba相当新鲜。需要帮助。
我附上了截图。
答案 0 :(得分:1)
a"不那么聪明"做到这一点的方式将是这样的:
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
如果你没有大量的线路......你也可以将所有线路放在一个集合中,然后删除其中的一个随机项目,直到计数达到你想要的行数(也不是这样)智能解决方案):
{{1}}
如果您仍有疑问,请询问;)
答案 1 :(得分:1)
一种解决方案是在数组中加载行,对行进行洗牌并将数组写入目标:
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