Question

我根据包含两列的电子表格提出了非常具体的请求。我想将值“交易金额”和第二个“名称/地址”（不是第一个和第三个）字段搜索到单独的工作表中。有37条这样的电线，我需要它贯穿每一条。有任何想法吗？这就是我到目前为止所拥有的。它将根据交易金额进行复制，但我也希望它复制第二个名称/地址字段并粘贴到下一列的行中。

谢谢！

Sub cond_copy()
 'assuming the data is in sheet1
Sheets("Sheet1").Select
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
For i = 1 To RowCount
     'assuming the true statment is in column a
    Range("a" & i).Select
    check_value = ActiveCell
    If check_value = "Transaction Amount" Or check_value = "Transaction Amount" Then
        ActiveCell.EntireRow.Copy
         'assuming the data is in sheet2
        Sheets("Sheet2").Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next

End Sub

http://i.stack.imgur.com/vD3FZ.png

Answer 1

第二个Name/Address字段是否总是低于Transaction Amount的9行？如果是这种情况，你可以试试这个......

我也建议远离.Select。通常不需要它，降低性能，根据我的经验，会导致间歇性错误。

Sub cond_copy()
 'assuming the data is in sheet1
    RowCount = 1
    addressCounter = 0
    With Worksheets("Sheet1")
        For i = 1 To .Cells(.Cells.rows.Count, "a").End(xlUp).row
             'assuming the true statment is in column a
            If .Cells(i, "A").value = "Transaction Amount" Then
                For x = i + 1 To .Cells(.Cells.rows.Count, "a").End(xlUp).row
                    If .Cells(x, "A").value = "Name/Address" Then addressCounter = addressCounter + 1
                    If addressCounter = 2 Then
                        Worksheets("Sheet2").Cells(RowCount, "A").value = .Cells(i, "B").value
                        Worksheets("Sheet2").Cells(RowCount, "B").value = .Cells(x, "B").value
                        RowCount = RowCount + 1
                        addressCounter = 0
                        Exit For
                    End If
                Next

                i = x - 1
            End If
        Next
    End With
End Sub

B列中的VBA复制值基于A列中的值并粘贴到另一个工作表中

1 个答案: