从另一个文件中拉出随机的行

我试图创build一个审计电子表格，从其他电子表格中抽取5％的行并将其复制/粘贴到“审计电子表格”中。 到目前为止，我已经知道如何通过以下方式进行随机抽取：

Option Explicit Sub Random20() Randomize 'Initialize Random number seed Dim MyRows() As Integer ' Declare dynamic array. Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer 'Determine Number of Rows in Sheet1 Column A numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row 'Get 20% of that number percRows = numRows * 0.2 'Allocate elements in Array ReDim MyRows(percRows) 'Create Random numbers and fill array For nxtRow = 1 To percRows getNew: 'Generate Random number nxtRnd = Int((numRows) * Rnd + 1) 'Loop through array, checking for Duplicates For chkRnd = 1 To nxtRow 'Get new number if Duplicate is found If MyRows(chkRnd) = nxtRnd Then GoTo getNew Next 'Add element if Random number is unique MyRows(nxtRow) = nxtRnd Next 'Loop through Array, copying rows to Sheet2 For copyRow = 1 To percRows Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _ Destination:=Sheets(2).Cells(copyRow, 1) Next End Sub 

我正在寻找一种适应方法，以便用户select他们想要从中提取的文件，并自动填充他们自己的Excel电子表格以进行审计。

另外，还有两个标题行。

Answer 1

这是你所需要的一切：

 Sub GetRandomRows() PULLPERCENT = 0.05 Dim i&, j&, k&, n&, r, s, v, wb As Workbook s = Application.GetOpenFilename("Excel Files *.xls* (*.xls*),") If s <> False Then Set wb = Workbooks.Open(s) n = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row s = "" Randomize Do j = Int(n * Rnd + 1) If InStr(s, "." & j) = 0 Then s = s & "." & j k = k + 1 End If Loop Until (k > n * PULLPERCENT) r = Split(s, ".") For i = 1 To n * PULLPERCENT v = wb.Worksheets(1).Rows(2 + r(i)).EntireRow ThisWorkbook.Worksheets(2).Cells(i, 1).EntireRow = v Next wb.Close False End If End Sub 

Answer 2

我认为会做你所需要的：

 Sub Audit() Dim otherWorkbook As Excel.Workbook Dim fileName As String Dim i As Long, x As Long, y As Long Dim rowNumbers As Object Dim auditNumber As Long Set rowNumbers = CreateObject("System.Collections.ArrayList") fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*") If Not LCase(fileName) = "false" Then Set otherWorkbook = Workbooks.Open(fileName) auditNumber = otherWorkbook.Sheets(1).Find(What:="*", After:=otherWorkbook.Sheets(1).Cells(1), _ Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, MatchCase:=False).Row * 0.2 '// 0.2 = 20% rowNumbers.Add WorksheetFunction.RandBetween(3, auditNumber) While rowNumbers.Count < auditNumber y = WorksheetFunction.RandBetween(3, otherWorkbook.Sheets(1).UsedRange.Rows.Count) If Not rowNumbers.Contains(y) Then rowNumbers.Add y Wend For i = 0 To rowNumbers.Count - 1 x = x + 1 otherWorkbook.Sheets(1).Rows(rowNumbers(i)).EntireRow.Copy _ Destination:=ThisWorkbook.Sheets(1).Cells(x, 1) Next End If