让VBA搜索excel

Question

亲爱的好日子 在（主）图片我有这些数据和在（导出）图片我有结果。 在我的代码中，我想使（代理名称）取决于我将使用代理名称创建它的特定行。这意味着我不想复制每个代理的代码。 如果我添加另一个代理，它将自动在（导出）图片中添加另一行。在我的代码中，行以＆＃34; A1＆＃34;以及其他记录＆＃34; A2＆＃34;，＆＃34; A3＆＃34; .....等 我只想要make（Agent_Name）多个记录，并依赖于我将创建它的特定行

Sub MatchingCityAndCardType2()
Dim City As String, Sale_Type As String, Agent_name As String, i As Long, rData As Range, j As Long, Last_Row As Long
Last_Row = Cells(Rows.Count, "H").End(xlUp).Row
Sheets("Remaining").Cells.ClearContents

For i = Last_Row To 2 Step -1
    Agent_name = Cells(i, "B").Value
    City = Cells(i, "D").Value
    Sale_Type = Cells(i, "E").Value

    If City = "Erbil" And Sale_Type = "bazar" And Agent_name = "Ali" And Mid(Cells(i, "H"), 1, 6) = 49000 Then
        'Set the range destination, Range(“A2”), depending on which
        'range you want in Sheets(“Remaining”)
        Rows(i).EntireRow.Copy Destination:=Worksheets("Remaining").Range("A1")
        Exit For
    End If

Next i



End Sub

Answer 1

我将代理名称作为参数。 sub现在将添加与creteria匹配的行到Sheets（“Remaining”）。你可以像这样MatchingCityAndCardType2 "Ali"

来调用sub

Sub MatchingCityAndCardType2(AgentName As String)
    Dim City As String, Sale_Type As String, Agent_name As String, i As Long, rData As Range, j As Long, Last_Row As Long
    Last_Row = Cells(Rows.Count, "H").End(xlUp).Row
    Sheets("Remaining").Cells.ClearContents

    For i = Last_Row To 2 Step -1
        Agent_name = Cells(i, "B").Value
        City = Cells(i, "D").Value
        Sale_Type = Cells(i, "E").Value

        If City = "Erbil" And Sale_Type = "bazar" And Agent_name = AgentName And Mid(Cells(i, "H"), 1, 6) = 49000 Then
            'Set the range destination, Range(“A2”), depending on which
            'range you want in Sheets(“Remaining”)
            Rows(i).EntireRow.Copy Destination:=Worksheets("Remaining").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Exit For
        End If

    Next i

End Sub

Answer 2

首先，您必须从代码中删除此行：Sheets("Remaining").Cells.ClearContents。其次，将此变量添加到变量 Last_Row ：

下面

Last_Row2 = Worksheets("Remaining").Cells(Rows.Count, "B").End(xlUp).Row + 1

第三，更换一行：

Rows(i).EntireRow.Copy Destination:=Worksheets("Remaining").Range("A1")

这一行：

Rows(i).EntireRow.Copy Destination:=Worksheets("Remaining").Range("A" & Last_Row2)

完成！