在 vba 中复制和粘贴答案

【问题标题】：copy and paste in vba在 vba 中复制和粘贴
【发布时间】：2016-10-26 06:47:15
【问题描述】：

Excel VBA 编码有问题。

我想做一个编码可以在某些条件下将数据从一张表复制到一张表。我的数据格式为二进制。

sheet1 中的数据有将近一千行。我只想从 sheet1 到 sheet 2 中随机取 15 行数据。必须满足的条件是每列只有该列的总和为 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

【问题讨论】：

你自己尝试过什么？向我们展示您迄今为止编写的任何代码，以便我们提供帮助。 SO 不是编码服务。
您希望所有列的总和为 3 吗？或任何单列？每行有多少列数据？我能想到的只是一个心理上很长的公式，用一个双重的 for next 循环来检查每一列的总数..
如果它是单列数据，那么我会Dim ClmTtl As Integer 并像你一样开始一个'for''next'循环，但在循环之前ClmTtl = 0 然后循环每个行号添加值从该列到ClmTtl 的每个单元格。在循环之后，您可以执行 if 来查看 value 是否 = 3，如果不是 goto 代码中的早期阶段，或者再次调用 sub 以重新启动它。
@Glitch_Doctor 是的。我想要所有列总计 3。你能告诉我代码吗？ ?
嗯，这当然是可以实现的，但是对于多个列，代码将非常努力地工作，如果没有答案，它可能会无限循环。为了使代码保持完全随机，大多数结果不会在每列中为 3，因此将失败并重新开始，因此它是否必须是完全随机的，或者您是否可以考虑一些辅助代码，例如现在列的总数为 3，然后过滤剩余结果为 0 并改为搜索特殊单元格？只是因为代码执行得更快......

标签： vba excel

【解决方案1】：

这将实现您正在寻找的东西，但代码将需要很长时间才能执行，我实际上使用 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 时才能继续到下一列，因此代码只有在它们都达到所需总数时才能完成。希望这会有所帮助，祝您减少运行时间。

【讨论】：