vba - 在 2 个不同的列中搜索 2 个值

Question

我有 2 个搜索单元 B2 和 B3。我希望他们从名为 fakturor 的表中查找和写入数据。我与一个 B2 一起工作得很好，可以在工作表 fakturor 的 B 列中进行搜索。但是，如果我希望 B2 和 B3 中的值在同一行上都是正确的，我该怎么办？

我的剧本

Sub SearchForString()

With Worksheets("Budget")
    Rows("11:" & .Rows.Count).Clear
End With

Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 11

Dim sheetTarget As String: sheetTarget = "Budget"
Dim sheetToSearch As String: sheetToSearch = "Fakturor"
'Value in Budget!B2 to be searched in Fakturor
Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("B2").Value
'Value in Column B will be searched
Dim columnToSearch As String: columnToSearch = "B"

Dim iniRowToSearch As Integer: iniRowToSearch = 1
Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
Dim maxRowToSearch As Long: maxRowToSearch = 2000 'There are lots of rows, so better setting a max. limit

If (Not IsEmpty(targetValue)) Then
    For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count

        'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
        If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then

            'Select row in Sheet1 to copy
            Sheets(sheetToSearch).Rows(LSearchRow).Copy

            'Paste row into Sheet2 in next row
            Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
        End If

        If (LSearchRow >= maxRowToSearch) Then
            Exit For
        End If

    Next LSearchRow

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select


End If

Exit Sub

Err_Execute:
    MsgBox "Ett fel har inträffat, prata med Per"

End Sub

Answer 1

看看这是否有帮助，我添加了额外的搜索条件。我还稍微调整了您的代码以使其更具可读性，但本质上是相同的。请注意，这IsEmpty(targetValue)不是一个有效的 statemnet，因为targetValue它是一个字符串。Empty 仅适用于变体。

Sub SearchForString()

    Dim wS As Worksheet
    Dim wT As Worksheet
    Dim LCopyToRow As Integer
    Dim targetValue As String
    Dim targetValue2 As String
    Dim rS As Range, cel As Range
    Const csSrch As String = "$B$1"

    On Error GoTo Err_Execute

    Application.ScreenUpdating = False

    Set wS = ThisWorkbook.Worksheets("Fakturor")
    Set wT = ThisWorkbook.Worksheets("Budget")

    With wT
        .Range(.Rows(11), .Rows(.Rows.Count)).Clear
    End With

    targetValue = wT.Range("B2").Value
    targetValue2 = wT.Range("B3").Value

'   Start copying data to row 11 in Budget (row counter variable)
    LCopyToRow = 11
'   Value in Budget!B2 to be searched in Fakturor
'
'   limit source range to end of data
    Set rS = wS.Range(csSrch, wS.Cells(wS.Rows.Count, Range(csSrch).Column).End(xlUp))

    If Len(targetValue) > 0 And Len(targetValue2) > 0 Then
        For Each cel In rS
'If value in the current row columns B=targetValue AND columns C=targetValue2, copy entire row to LCopyToRow in sheetTarget
            If cel.Value = targetValue And cel.Offset(, 1).Value = targetValue2 Then
                cel.EntireRow.Copy
                wT.Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues 'Paste row into Budget in next row
                LCopyToRow = LCopyToRow + 1 'Move counter to next row
            End If
        Next cel

        Application.CutCopyMode = False
        wT.Select
        wT.Range("A3").Select 'Position on cell A3
    End If

    Application.ScreenUpdating = True

Exit Sub

Err_Execute:
    MsgBox "Ett fel har inträffat, prata med Per"

End Sub