Изменение диапазона формы на Столбцы (a, b, c, d) - PullRequest
0 голосов
/ 28 марта 2019

Я работаю над макросом для извлечения данных из разных строк (есть несколько пустых строк), но я хочу, чтобы он осуществлял поиск и извлечение вместо диапазона, извлекаемого из столбцов 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

1 Ответ

0 голосов
/ 28 марта 2019

Код 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...