VBAでの相対セル参照

Question

私はA、B、Cの3つの列にデータを持っています。 列Aと列Bが一致する場合、次の3つの値を列Cからコピーします。 AとBが3行目で一致するので、列Cから番号1,3と6をコピーします。

A B C 
1 2 4 
3 4 4 
5 5 1 
4 6 3 
4 8 6 
1 8 3 

私はリサイズ、Range(Cells(Selection.Row, 1), Cells(Selection.Row, 3)).Copyなどを試してみましたが、何も動作するようには思えません。

Sub test() 

Dim rngsize As Range, rngsize2 As Range, rngmake As Range, rngmake2 As Range, rngprice As Range, rngprice2 as range, i As Integer, j As Integer, x As Integer 
x = 3 
For i = 2 To Sheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Row 
    For j = 7 To Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row 

     Set rngsize = Sheets("Sheet3").Range("E" & i) 
     Set rngsize2 = Sheets("Sheet2").Range("E" & j) 

     Set rngmake = Sheets("Sheet3").Range("F" & i) 
     Set rngmake2 = Sheets("Sheet2").Range("F" & j) 

     Set rngprice = Sheets("Sheet3").Range("X" & i) 
     Set rngprice2 = Sheets("Sheet2").Range("X" & j) 


     If rngsize * 0.5 <= rngsize And rngsize2 + 1.5 >= rngsize Then 

      If rngmake2 * 0.5 <= rngmake And rngmake2 * 1.5 >= rngmake Then 

       Range(Cells(Selection.Row, 1), Cells(Selection.Row, 3)).Copy 

       rngprice2.Copy 

       Worksheets("Sheet4").Range("F" & x).PasteSpecial Paste:=xlPasteValues 

       Application.CutCopyMode = xlCopy 


       x = x + 1 

      End If 
     End If 

    Next j 

Next i 

End Sub 

Answer 1

あなたのコードに従うことができなかったので、あなたの例と説明に基づいて何かを一緒に投げました。アプリケーションに合わせて定数やワークシートを変更する必要があります。

Aが同じ行のBと一致する場合、その行からCをコピーし、次の2行からCを別のワークシートにコピーします。

Private Sub CopyMatch() 

Dim i As Integer 
Dim j As Integer 
Dim wsCopy As Worksheet 
Dim wsPaste As Worksheet 

Const intACol As Integer = 1 
Const intBCol As Integer = 2 
Const intCCol As Integer = 3 
Const intPasteCol As Integer = 1 
Const intCopyRowStart As Integer = 2 
Const intPasteRowStart As Integer = 1 

'assign worksheets 
Set wsCopy = Sheets("Sheet1") 
Set wsPaste = Sheets("Sheet2") 

'cycle through each row 
i = intCopyRowStart 
j = intPasteRowStart 
Do Until wsCopy.Cells(i, intACol).Value = "" And _ 
     wsCopy.Cells(i, intBCol).Value = "" And _ 
     wsCopy.Cells(i, intCCol).Value = "" 
    'check for A-B match 
    If wsCopy.Cells(i, intACol).Value = wsCopy.Cells(i, intBCol).Value Then 
     'copy C value from match row + 2 next rows for C 
     wsCopy.Range(Cells(i, intCCol), Cells(i + 2, intCCol)).Copy 
     'paste in other sheet 
     wsPaste.Cells(j, intPasteCol).PasteSpecial Paste:=xlPasteValues 
     j = j + 3 
    End If 
    i = i + 1 
Loop 

End Sub 

これは別のシートに値1,3、& 6を戻しました。次のようにあなたのコードにこれを適用する

---

私の試みは、次のとおりです。

Sub test() 

Dim rngsize As Range, rngsize2 As Range, rngmake As Range, rngmake2 As Range, rngprice As Range, rngprice2 As Range, i As Integer, j As Integer, x As Integer 
x = 3 
For i = 2 To Sheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Row 
    For j = 7 To Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row 

     Set rngsize = Sheets("Sheet3").Range("E" & i) 
     Set rngsize2 = Sheets("Sheet2").Range("E" & j) 
     Set rngmake = Sheets("Sheet3").Range("F" & i) 
     Set rngmake2 = Sheets("Sheet2").Range("F" & j) 
     Set rngprice = Sheets("Sheet3").Range("X" & i) 
     Set rngprice2 = Sheets("Sheet2").Range("X" & j) 

     If rngsize * 0.5 <= rngsize And rngsize2 + 1.5 >= rngsize Then 
      If rngmake2 * 0.5 <= rngmake And rngmake2 * 1.5 >= rngmake Then 
       Sheets("Sheet2").Range(Cells(rngprice.Row, rngprice.Column), Cells(rngprice.Row + 2, rngprice.Column)).Copy 
       Sheets("Sheet4").Range("F" & x).PasteSpecial Paste:=xlPasteValues 
       x = x + 3 
      End If 
     End If 
    Next j 
Next i 

End Sub 

これは、しかし意図したとおり、それが動作するかどうかわからない、実行されます。