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

时间:2016-03-16 02:14:03

标签: excel vba random get

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相当新鲜。需要帮助。

我附上了截图。

layout

2 个答案:

答案 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