0

2 つの検索セル B2 と B3 があります。そして、fakturor というシートからデータを見つけて書き込んでもらいたいのです。シート fakturor の列 B で検索するために、1 つの B2 で問題なく動作します。しかし、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
4

1 に答える 1

0

これが役立つかどうかを確認してください。追加の検索基準を追加しました。また、コードを少し調整して読みやすくしましたが、基本的には同じです。IsEmpty(targetValue)は文字列であるため、有効なステートメントではないことに注意してください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
于 2013-11-12T08:10:35.457 に答える