excel - 将表单范围更改为列 (a,b,c,d)

Question

我正在研究宏以从不同的行中提取数据（有一些空白行），但我希望它搜索和提取而不是从范围中提取从列 AD 中提取这可以(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

标签： excelvba

Answer 1

代码 1用于查找我们搜索的字符串的第一次出现：

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用于搜索整个范围并检查我们搜索的字符串的所有出现：

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