在vba中复制和粘贴
在vba中复制和粘贴
提问于 2016-10-26 06:47:15
我对Excel VBA编码有问题。
我想做一个编码，可以将数据从一个工作表复制到具有特定条件的工作表。我的二进制形式的数据。
sheet1中的数据有近千行。我只想从sheet1中随机取15行数据到表2。必须满足的标准是每列只有列的和是3。如果不满足，将采取其他数据。
当我单击生成时。它将从数据表1复制到数据表2。我想要像红色圆圈一样的数据副本。不像红色的那一列。请帮帮我
Option Explicit
Sub Random20()
Randomize
Dim MyRows() As Integer
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
percRows = 17
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回答 1
Stack Overflow用户
发布于 2016-10-27 10:31:09
这将实现您正在寻找的东西，但是代码将花费很长时间来执行，我实际上使用RANDBETWEEN(1,COUNTIF(Sheet1!A:A,"<>"&""))和RandBetweenInt(1,COUNTIF(Sheet1!A:A,"<>"&""),***Range of Random Integers from above***) (一个用户定义的函数找到here)模拟了模拟您的代码的公式。这样计算的速度要快得多，而且不包括重复的随机数字。
Sub chkRand()
Application.Calculation = xlCalculationManual
Do Until Worksheets("Sheet3").Range("I18").Value = 1
Application.Calculate
Loop
End Sub.Range("I18")的公式为=IF(COUNTIF(B18:H18,3)=7,1,0)，因此这将强制手动计算，然后重新计算，直到所有列的总和为3。
要小心，虽然我已经让这个宏运行了30分钟，但它仍然没有找到匹配项。
以防万一您真的在寻找我将使用的VBA唯一的解决方案：
For Clm = 2 To 8
ClmTtl = 0
For copyRow = 1 To percRows
ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
Next
If Not ClmTtl = 3 Then Call Random20
Next尽管我总是建议先寻求基于公式的解决方案，并仅在需要的地方使用宏。
因为这只能在前一列总和为3时才能继续到下一列，所以代码只有在它们都达到所需总和时才能完成。希望这能有所帮助，祝你好运，减少运行时间。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/40255462
复制相关文章
相似问题
腾讯云开发者
