Question

我一直在尝试在一个工作表上连续匹配2个条件，并将整行复制到同一工作簿中的另一个工作表。当循环继续时，标准也将增加，如1,2,3或1A，2A，3A等。如何使用匹配函数，以便在匹配时复制整行。

查找第一个标准，如果匹配，请查找下一个标准。第二，第三标准是不同的列，但是同一行。
如果第二个条件不匹配，请在不同的行中查找匹配第一个条件的下一行
如果两个条件匹配，则将整行复制并粘贴到另一个工作表
标准增加并且匹配功能开始以找到新的匹配标准

我一直在尝试使用此代码，但似乎没有工作或给出很多错误，而不是使用INDEX，我将其更改为CopyEntireRow。

=INDEX($D$2:$D$10,MATCH(1,(A13=$B$2:$B$10)*(B13=$C$2:$C$10),0))

我需要一些帮助或建议，以便更好地改进这种方法。谢谢！

1个标准代码

Private Sub CommandButton1_Click()
Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False

Set wSht = Worksheets("Data")
With wSht.Range("BM1:BM5000")
Set rngC = .Find(What:="PVC/", lookat:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
 Do
   strLastRow = Sheets("Cable List").Range("BJ" & Rows.Count).End(xlUp).Row + 1
   rngC.EntireRow.Copy
   Sheets("Cable List").Cells(strLastRow, 1).PasteSpecial xlPasteValues
   Application.CutCopyMode = False
   Set rngC = .FindNext(rngC)
 Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With

上面的代码在一个工作表“Data”中找到“PVC /”字符串，所有匹配的字符串里面的字符串将被复制到“Cable_List”页面。

Answer 1

也许是这样的（未经测试的）

Private Sub CommandButton1_Click()
Dim LastRow As Long, lb As Long
Dim rngC As Range
Dim arrToFind, colToSearch, FirstAddress As String
Dim wSht As Worksheet, shtList As Worksheet, rw As Range
Dim rngtest As String, i As Long
Dim hit As Boolean

    Application.ScreenUpdating = False

    'array of words to search for
    arrToFind = Array("PVC/", "Test1", "Test2")

    'array of which column to look in for each word
    colToSearch = Array(65, 66, 67)

    lb = LBound(arrToFind) 'never count on lbound being zero...

    Set wSht = Worksheets("Data")
    Set shtList = Sheets("Cable List")

    LastRow = shtList.Range("BJ" & Rows.Count).End(xlUp).Row + 1

    With wSht.Cells(1, colToSearch(lb)).Resize(5000, 1)

        Set rngC = .Find(What:=arrToFind(lb), lookat:=xlPart)

        If Not rngC Is Nothing Then
            FirstAddress = rngC.Address
            Do
                hit = True
                Set rw = rngC.EntireRow

                For i = (lb + 1) To UBound(arrToFind)
                    If rw.Cells(colToSearch(i)).Value <> arrToFind(i) Then
                        hit = False
                        Exit For
                    End If
                Next i

                If hit = True Then
                    shtList.Rows(LastRow).Value = rw.Value
                    LastRow = LastRow + 1
                End If

                Set rngC = .FindNext(rngC)
             Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
        End If
    End With

End Sub

使用Match功能复制具有多个条件和增量的行

1 个答案: