コードのループをt/fデータbtwに統合する方法。 2つの条件

Question

に基づくwkshtsは、私は以下のコードを発見し、ここからそれを修正：https://www.youtube.com/watch?v=AzhQ5KiNybk - 「条件に基づいて別のワークシートから特定のワークシート範囲データを転送する」

CODE概要：私は中に以下のVBA Excelのコードを使用Excel 2013を使用してCPDesignと呼ばれるwkshtの列FからYにデータをコピーし、ルックアップ値を使用してDesignと呼ばれるwksht（同じwkbk内）の列HからAAに貼り付けます。これはCPDesign wkshtのB列にNodeAとNodeBとして定義した値を参照し、Design wkshtのC列でその値を検索し、前述のように対応するデータをコピーして貼り付けます。

例WKSHTS：CPDesign（データをコピーしているwksht）はNodeという名前のノード名（NodeAとNodeBという名前）をNodeという単一の列に示します。例：

Hub   Node  SourceTx   SourceRx 
Allentown  V12345   14a     3a  
Allentown  V78945   14b     3b 
Allentown  V33333   15a     2a 
Allentown  V44444   15a     2b 

デザイン（私がデータを貼り付ける必要がありwkshtは）お互いに次の二つの異なる列に記載されているノードAとノードBの値を持っています。以下のwkshtの短縮版。例：

Hub  NodeA  NodeB SourceTxA  SourceTxB  SourceRxB   
Allentown V12345 V78945 (paste here) (paste here) (paste here) 
Allentown V33333 V44444 (paste here) (paste here) (paste here) 

質問：私は、ノードAのコードを取り、ノードAのためのループの下にそれをコピー＆ペーストしてノードBのためのループ作品次のコード作られたが、私は統合する方法を知りたいですそれはよりよく見えるようにノードAループを持つノードBのためのコード？ （私はそれが私のコードのようにとどまり、私は理解していない何かに変えないでください。ビデオからこのコードを理解してください:)）

ありがとう。

CODE：コードは最後にシートまたは細胞を活性化しないが、あなたはすでにそれを行う方法を知っている:)：

Sub Main() 

Dim wbCP As Worksheet: Set wbCP = ActiveWorkbook.Worksheets("CPDesign") 
Dim wbD As Worksheet: Set wbD = ActiveWorkbook.Worksheets("Design") 
Dim intLastrowCP As Integer: intLastrowCP = wbCP.Range("A" & Rows.Count).End(xlUp).Row 
Dim intLastrowD As Integer: intLastrowD = wbD.Range("A" & Rows.Count).End(xlUp).Row 
Dim intCountCP As Integer 
Dim intCountD As Integer 
Dim strCurrentCPNode As String 

' Loop through CPDesign sheet 
For intCountCP = 2 To intLastrowCP 

    ' Get current Node in CPdesign 
    strCurrentCPNode = wbCP.Cells(intCountCP, "B").Value 

    ' Loop through Design sheet 
    For intCountD = 2 To intLastrowD 

     ' Does the node match NodeA in Design sheet 
     If wbD.Cells(intCountD, "B").Value = strCurrentCPNode Then 

      ' It does so set the SourcerTxA column value 
      wbD.Cells(intCountD, "D").Value = wbCP.Cells(intCountCP, "C").Value 

     ' Does the node match NodeB in Design sheet 
     ElseIf wbD.Cells(intCountD, "C").Value = strCurrentCPNode Then 

      ' It does so set SourceTxB and SourceRxB values 
      wbD.Cells(intCountD, "E").Value = wbCP.Cells(intCountCP, "C").Value 
      wbD.Cells(intCountD, "F").Value = wbCP.Cells(intCountCP, "D").Value 

     End If 

    Next 

Next 

' Clear objects 
Set wbCP = Nothing 
Set wbD = Nothing 

End Sub 

注を：

Sub transfer() 
Dim i As Long, j As Long, lastrowCP As Long, lastrowD As Long 
Dim NodeA As String 
Dim NodeB As String 

lastrowCP = Sheets("CPDesign").Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 To lastrowCP 

'CPDesign is spreadsheet I am copying data from 
‘NodeA and NodeB are all in column B of CPDesign spreadsheet 
NodeA = Sheets("CPDesign").Cells(i, "B").Value 
NodeB = Sheets("CPDesign").Cells(i, "B").Value 

'Design is spreadsheet I am copying data to 
Sheets("Design").Activate 
lastrowD = Sheets("Design").Range("A" & Rows.Count).End(xlUp).Row 

'NodeA~~~ 

For j = 2 To lastrowD 
'Design is Design what I'm pasting into 
‘if value in NodeA column of CPDesign spreadsheet = value in column B of   
Design spreadsheet, then _ 
‘continue with code 
If Sheets("Design").Cells(j, "B").Value = NodeA Then 

Sheets("CPDesign").Activate 
Sheets("CPDesign").Range(Cells(i, "F"), Cells(i, "Y")).Copy 
Sheets("Design").Activate 
Sheets("Design").Range(Cells(j, "H"), Cells(j, "AA")).Select 
ActiveSheet.Paste 
End If 

Next j 
Application.CutCopyMode = False 
Next i 

'NodeB~~~ 
'just repeated code above for NodeA except minus the Dim's. Can I consolidate this with Node A loop above so that it looks better? 
lastrowCP = Sheets("CPDesign").Range("A" & Rows.Count).End(xlUp).Row 

For i = 2 To lastrowCP 
NodeA = Sheets("CPDesign").Cells(i, "B").Value 
NodeB = Sheets("CPDesign").Cells(i, "B").Value 

Sheets("Design").Activate 
lastrowD = Sheets("Design").Range("A" & Rows.Count).End(xlUp).Row 
For j = 2 To lastrowD 
‘if value in NodeB column of CPDesign spreadsheet = value in column C of Design spreadsheet, then _ 
‘continue with code 
If Sheets("Design").Cells(j, "C").Value = NodeB Then 

Sheets("CPDesign").Activate 
Sheets("CPDesign").Range(Cells(i, "F"), Cells(i, "Y")).Copy 
Sheets("Design").Activate 
Sheets("Design").Range(Cells(j, "H"), Cells(j, "AA")).Select 
ActiveSheet.Paste 
End If 

Next j 
Application.CutCopyMode = False 
Next i 

'END NodeA and NodeB Loops~~~ 

'when data transferred can go to sheet 1 
Sheets("Design").Activate 
'and end routine by selecting cell A1 
Sheets("Design").Range("A1").Select 

End Sub 

Answer 1

はこれを試してみてください