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是一个字符串。空仅适用于变体。

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

使用2个不同的列中的2个值进行搜索

1 个答案: