將生成的列複製並粘貼到另一個電子表格中

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，並且我正在運行時構建字符串。