Question

我有三列A，B和C的数据。如果列A和B之间存在匹配，我想从列C复制以下3个值。例如，我想从列C复制数字1,3和6，因为A和B在第三行匹配。

<b>sprintf("%02d",$counter)</b> ... <strong class=\"resultsLink\">$post_title</strong> to show 01 02 03

我尝试过Resize，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

Answer 1

我无法关注您的代码，因此我根据您的示例和说明将某些内容放在一起。您必须修改常量和工作表以适合您的应用程序。

从您的描述和示例中，您需要VBA：当A匹配同一行中的B时，将该行中的C和后两行中的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和＆amp; 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

它运行，但不确定它是否按预期工作。

VBA中的相对单元引用

1 个答案: