将生成的列复制并粘贴到另一个电子表格中

Question

我想知道是否有人可以帮我缩短代码，因为我担心在我添加其他代码后可能需要很长时间才能运行。我想要做的将是解释如下：

我想复制说test2的（也注意到，该隔离装置的变量是对自己的行和列）

test1 1 2 1 
test2 2 1 4 
test3 1 1 1 

复制它后我会将它粘贴在其他表单上。

让说，我有另外的结果集 说

test2 2 1 4 
test3 3 9 8 
test5 1 1 1 

我想复制test2的，但我的VBA编码的werent能够因为它仍然假设test2的是在第二排。

最后一种情况是，如果test2不可用，它将继续复制结果的其余部分并将其粘贴到其他工作表。

我已经做了一些编码，通过运行并帮助我解决这个问题。谢谢！

Sub Macro1() 

iMaxRow = 6 ' or whatever the max is. 
    'Don't make too large because this will slow down your code. 

    ' Loop through columns and rows 
    For iCol = 1 To 1 ' or however many columns you have 
     For iRow = 1 To 1 

     With Worksheets("Sheet3").Cells(iRow, iCol) 
      ' Check that cell is not empty. 
      If .Value = "Bin1" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin2" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin3" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin4" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin5" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin6" Then 
       Range("A1:G1").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A1").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 



     End With 

    Next iRow 
    Next iCol 

For iCol1 = 1 To 1 ' or however many columns you have 
     For iRow1 = 1 To 2 

     With Worksheets("Sheet3").Cells(iRow1, iCol1) 
      ' Check that cell is not empty. 

       If .Value = "Bin2" Then 
       Range("A2:G2").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A2").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin3" Then 
       Range("A2:G2").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A2").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin4" Then 
       Range("A2:G2").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A2").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin5" Then 
       Range("A2:G2").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A2").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin6" Then 
       Range("A2:G2").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A2").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 

     End With 

    Next iRow1 
    Next iCol1 

For iCol2 = 1 To 1 ' or however many columns you have 
     For iRow2 = 1 To 3 

     With Worksheets("Sheet3").Cells(iRow2, iCol2) 
      ' Check that cell is not empty. 

       If .Value = "Bin3" Then 
       Range("A3:G3").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A3").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin4" Then 
       Range("A3:G3").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A3").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin5" Then 
       Range("A3:G3").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A3").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin6" Then 
       Range("A3:G3").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A3").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 

     End With 

    Next iRow2 
    Next iCol2 

For iCol3 = 1 To 1 ' or however many columns you have 
     For iRow3 = 1 To 4 

     With Worksheets("Sheet3").Cells(iRow3, iCol3) 
      ' Check that cell is not empty. 

       If .Value = "Bin4" Then 
       Range("A4:G4").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A4").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin5" Then 
       Range("A4:G4").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A4").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin6" Then 
       Range("A4:G4").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A4").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 

     End With 

    Next iRow3 
    Next iCol3 

For iCol4 = 1 To 1 ' or however many columns you have 
     For iRow4 = 1 To 5 

     With Worksheets("Sheet3").Cells(iRow4, iCol4) 
      ' Check that cell is not empty. 

       If .Value = "Bin5" Then 
       Range("A5:G5").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A5").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      ElseIf .Value = "Bin6" Then 
       Range("A5:G5").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A5").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 

     End With 

    Next iRow4 
    Next iCol4 

For iCol5 = 1 To 1 ' or however many columns you have 
     For iRow5 = 1 To 6 

     With Worksheets("Sheet3").Cells(iRow5, iCol5) 
      ' Check that cell is not empty. 

       If .Value = "Bin6" Then 
       Range("A6:G6").Select 
       Selection.Copy 
       Sheets("sheet4").Select 
       Range("A6").Select 
       ActiveSheet.Paste 
       Sheets("sheet3").Select 
      End If 

     End With 

    Next iRow5 
    Next iCol5 
Sheets("Sheet4").Select 
Range("A1").Select 

End Sub 

Answer 1

我很努力地确定你的代码的功能。下面我指出一些简化和其他必要的改进，但是一旦我们清除了灌木丛，可能会有更多。

变化1

请使用Option Explicit，并请声明变量。这避免了拼写错误变量被视为新的隐式声明。

变化2

请使用Application.ScreenUpdating = False。这可以避免在宏完成其任务时重新绘制屏幕。由于所有纸张之间的切换，这对于您的代码而言至关重要。我的代码不太重要，因为我不切换工作表。

更改3

替换：

With Sheets("Sheet3") 
    : 
    Range("A1:G1").Select 
    Selection.Copy 
    Sheets("sheet4").Select 
    Range("A1").Select 
    ActiveSheet.Paste 
    Sheets("sheet3").Select 
    : 
End With 

由：

With Sheets("Sheet3") 
    : 
    .Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1") 
    : 
End With 

这避免了切换片，其是时间的最大的浪费。

变化4

对于每一个如果 - elseif的-elseif的-ENDIF你做同样的副本。所以：

If .Value = "Bin1" Or .Value = "Bin2" Or .Value = "Bin3" _ 
    .Value = "Bin4" Or .Value = "Bin5"     Then 

会有同样的效果。

摘要到目前为止

我相信下面的不完全一样，你的第一个循环：

Option Explicit 
Sub Macro1() 
    Dim iCol As Long 
    Dim iRow As Long 
    Dim ValueCell as String 

    With Sheets("Sheet3") 
    For iCol = 1 To 1 
     For iRow = 1 To 1 
     ValueCell = .Cells(iRow, iCol).Value 
     If ValueCell = "Bin1" Or ValueCell = "Bin2" Or ValueCell = "Bin3" Or _ 
      ValueCell = "Bin4" Or ValueCell = "Bin5"     Then 
     .Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1") 
     End If 
     Next 
    Next 
    End With 

End Sub 

可能进一步变化

是循环真正独立？对我来说，看起来好像你可以将它们合并成一个循环。

响应加入到评论

交换新科考虑你的问题代码：

• 您有六个双回路。
• 在每种情况下，外环为For iCol = 1 to 1。也就是说，你只检查列“A”，尽管你暗示如果代码更快，你会检查更多的列。
• 内部循环是For iRow = 1 to №。 №在第一圈为1，第二圈为2，第六圈为6。再一次暗示如果代码更快，你会检查更多的行。
• 每个回路的动作取决于№的值。行动№

表显示的效果：

Value 
of № Cells examined Values checked for Range moved 
    1 A1    "Bin1" ... "Bin6" A1:G1 
    2 A1, A2   "Bin2" ... "Bin6" A2:G2 
    3 A1, A2, A3  "Bin3" ... "Bin6" A3:G3 
    4 A1, A2, ... A4 "Bin4" ... "Bin6" A4:G4 
    5 A1, A2, ... A5 "Bin5", "Bin6"  A5:G5 
    6 A1, A2, ... A6 "Bin6"    A6:G6 

• 也就是说，在双回路№，您检查单元A1至A№，检查值 “Bin№” 到 “Bin6”如果找到，则将Sheets("Sheet3").Range("A№:G№")复制到Sheets("Sheet4").Range("A№)。

在您的文本和示例数据中，引用“text2”而不是“Bin2”。我不明白你在做什么。下面，我介绍一些更多的VBA，它可以帮助你创建你想要的代码。如果没有，你将不得不在你的问题中添加一个新的部分用英文解释你正在尝试做什么。

新语法1

考虑：

For iRow = 1 to 6 
    : 
    .Range("A6:G6").Copy Destination:=Worksheets("Sheet4").Range("A6") 
    : 
Next 

"A6:G6"和"A6"是，你可以建立在运行时字符串。

现在考虑：

For iRow = 1 to iRowMax 
    : 
    .Range("A" & iRowMax & ":G" & iRowMax)).Copy _ 
         Destination:=Worksheets("Sheet4").Range("A" & iRowMax) 
    : 
Next 

根据iRowMax的价值这给：

iRow Statement  
    1  .Range("A1:G1")).Copy Destination:=Worksheets("Sheet4").Range("A1") 
    2  .Range("A2:G2")).Copy Destination:=Worksheets("Sheet4").Range("A2") 
    3  .Range("A3:G3")).Copy Destination:=Worksheets("Sheet4").Range("A3") 

新语法2

在运行时更改了一系列的另一种方法是更换：

.Range(string) 

与

.Range(.Cells(RowTop,ColLeft),.Cells(RowBottom,ColRight)) 

有了这个语法，你可以很容易地指定所需大小的矩形。

新语法3

考虑：

For i = 1 to 5 
    If this(i) = that Then 
    Do something fixed 
    Exit For 
    End If 
Next 
' Exit For statement jumps to here 

在这个循环中，我测试五个值。如果有任何匹配，我会做一些事情。如果我在第一个值上找到匹配项，则不需要检查其他值。 Exit For允许我跳出For-Loop。如果存在嵌套for循环，仅Exit For退出内环

新语法4

"Bin1"，"Bin2"等也可以在运行时创建。

iRowMax = 4 
For iRow = 1 to iRowMax 
    For iBin = iRowMax to 6 
    If ValueCell = "Bin" & iBin Then 
     ' Move Range 
     Exit For 
    End If 
    Next 
    ' Exit For statement jumps to here 
Next 

随着iRow = 4时，内for循环设置iBin至4，5和6这设置"Bin" & iBin到"Bin4"，"Bin5"和"Bin6"。

所以：

For BinNum = iRowMax to 6 
    If ValueCell = "Bin" & BinNum Then 
     ' Move Range 
     Exit For 
    End If 
    Next 

是一样的：

If ValueCell = "Bin4" Or ValueCell = "Bin5" Or ValueCell = "Bin6" Then 
    ' Move Range 
    End If 

这个新的代码更复杂，更困难比原来的理解，但它可能是你所需要的。

摘要

，我已经向你靠的iRow的价值偏偏改变不同的方式。我希望他们中的一个能让你建立你想要的例程。

我没有测试过，但我认为这并不等同于原来的代码全部六个循环：

Option Explicit 
Sub Macro1() 
    Dim iBin as Long 
    Dim iCol As Long 
    Dim iRow As Long 
    Dim iRowMax as Long 
    Dim ValueCell as String 

    Application.ScreenUpdating = False 

    With Sheets("Sheet3") 
    For iRowMax = 1 to 6 
     For iCol = 1 To 1  ' This could be replaced by iCol = 1 at the top 
     For iRow = 1 To iRowMax 
      ValueCell = .Cells(iRow, iCol).Value 
      For iBin = iRowMax to 6 
      If ValueCell = "Bin" & iBin Then 
       .Range("A" & iRowMax & ":G" & iRowMax)).Copy _ 
         Destination:=Worksheets("Sheet4").Range("A" & iRowMax) 
      End If 
      Next iBin 
     Next iRow 
    Next iCol 
    End With 
End Sub 

注：只有删除所有Select语句使该代码比你快。其他更改使它更小，速度更慢，因为我有两个额外的For-Loops，并且我正在运行时构建字符串。