Question

我正在使用宏从不同的行（有一些空白行）提取数据，但我希望它搜索并提取而不是从要从广告列提取的范围提取数据，这可以从(A1:D100)然后如果A(x)的X的内容为“结果”，则停止循环。然后循环到下一个工作簿。

Sub tgr()

Dim wbDest As Workbook
Dim wsDest As Worksheet
Dim rCopy As Range
Dim sFolder As String
Dim sFile As String
Dim lRow As Long

Set wbDest = ThisWorkbook                   'The workbook where information will be copied into
Set wsDest = wbDest.Worksheets("Sheet1")    'The worksheet where information will be copied into
sFolder = "C:\Path\" 'The folder path containing the xlsx files to copy from

'would like sFolder to be the root folder and also 
'   search for any "*.xlsx" contained inside C:\temp

lRow = 1 'The starting row where information will be copied into

'Adjust the folder path to ensure it ends with \
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

'Get the first .xlsx file in the folder path
sFile = Dir(sFolder & "*.xlsx")

'Begin loop through each file in the folder
Do While Len(sFile) > 0

    'Open the current workbook in the folder
    With Workbooks.Open(sFolder & sFile)
        'Copy over the formulas from A1:C3 from only the first 
        '   worksheet into the destination worksheet
        Set rCopy = .Sheets(1).Range("C9:D26")
        wsDest.Cells(lRow, "A").Resize(rCopy.Rows.Count, rCopy.Columns.Count).Formula = rCopy.Formula

        'Advance the destination row by the number of rows being copied over
        lRow = lRow + rCopy.Rows.Count

        .Close False    'Close the workbook that was opened from the folder without saving changes
    End With
    sFile = Dir 'Advance to the next file
Loop

End Sub

Answer 1

代码1 用于查找我们搜索的字符串的 FIRST 出现情况

Option Explicit

Sub test()

    Dim rngSearch As Range, Position As Range
    Dim strSearch As String

    With ThisWorkbook.Worksheets("Sheet1")

        Set rngSearch = .Range("A1:D100") '<- Set the range i want to search in
        strSearch = "Test" '<- Set the string i want to search for

        Set Position = rngSearch.Find(strSearch) '<- Search for string in range

        If Not Position Is Nothing And .Range("A" & Position.Row).Value = "Results" Then '<- Check if string appears in the range and the value in column A and row where the string is "Results"

            'Code here

        End If

    End With

End Sub

代码2 用于搜索整个范围并检查 ALL 我们搜索的字符串的出现情况

Option Explicit

Sub test()

    Dim rngSearch As Range, cell As Range
    Dim strSearch As String

    With ThisWorkbook.Worksheets("Sheet1")

        Set rngSearch = .Range("A1:D100") '<- Set the range i want to search in
        strSearch = "Test" '<- Set the string i want to search for

        For Each cell In rngSearch
            If cell.Value = strSearch And .Range("A" & cell.Row).Value = "Results" Then
                'Code here
            End If
        Next cell

    End With

End Sub

将表单范围更改为列（a，b，c，d）

1 个答案: