結果の列をコピーして別のスプレッドシートに貼り付けてください

Question

他のコードを追加してから実行するには時間がかかるかもしれないので、誰かがコードを短くするのを助けることができるかどうかは疑問でした。私は何をしたい以下に説明されます。

私は

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

（間隔が変数は、自分の行と列の上にあることを意味していることに注意してください取るん）TEST2を言うコピーしたい、それをコピーした後他のシートに貼り付けます。

が

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

を言う 、私は結果の別のセットを持っている、としましょう私はtest2はコピーしたかったが、それはまだTEST2が2行目にあることを前提としていて、私のVBAのコーディングのことができるようしゃべれませんでした。

最後に、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 

これは時間の最大の無駄であるスイッチングシートを回避することができます。

各もし-のElseIf-のElseIf-ENDIFの変更4

あなたは同じコピーを行います。したがって：

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 

可能性のさらなる変化は

は本当に独立したループはありますか？私には、それらを単一のループにマージできるかのように見えます。あなたは、6つの二重ループを有する

• ：コメント

  のやり取りに応じて追加

  新しいセクションでは、問題のコードを考えてみましょう。

• いずれの場合も、外側ループはFor iCol = 1 to 1です。つまり、列Aを調べるだけですが、コードが高速であれば列を調べることになります。
• 内側のループはFor iRow = 1 to №です。 №は1番目のループでは1、2番目のループでは2、6番目のループでは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№)にコピーします。

テキストとサンプルのデータでは、 "Bin2"ではなく "text2"を参照しています。私はあなたが何をしようとしているのか理解していません。以下では、必要なコードを作成するのに役立ついくつかの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 

、私は5つの値をテストしています。一致すれば何かする。私が最初の値にマッチすると、他の値をチェックする必要はありません。 Exit For私はFor-Loopから飛び出すことができます。そこには、forループネストされている場合は、Exit Forは、内側のループに

新しい構文4

"Bin1"、"Bin2"を出そうにも、実行時に作成することができます。 = 4 iRowで

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 

、forループ内これは、"Bin4"から"Bin" & iBin、"Bin5"と"Bin6"を設定4、5及び6にiBinを設定します。

ので：

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

この新しいコードはより複雑であり、オリジナルよりも理解することがより困難であるが、それは何が必要かもしれ：

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

は同じです。

概要

私はあなたiRowの値に応じて、何が起こるか変更するさまざまな方法を示しています。私はそのうちの1人があなたが望むルーチンを構築することを可能にすることを願っています。

私はそれをテストしていないが、私はこれがあなたの元のコード内のすべての6つのループと同じことだと思う：

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文を削除するには、あなたより、このコードが速くなります。その他の変更は、私が2つの余分なFor-Loopsを持っており、実行時に文字列を作成しているので、それを小さくし、非常にわずかに遅くします。