VBA Копирование ячеек, связанных с определенным ключевым словом в столбце

Question

Я пытаюсь автоматизировать сверку банковских выписок.Мне нужно найти определенное ключевое слово в столбце B, затем скопировать значение 4 столбца справа от этого слова и вставить его в отдельный лист для каждого экземпляра, в котором находится это ключевое слово.Я на 100% новичок в макросах.Я адаптировал свой код из этого поста: VBA - найдите конкретное слово в столбце и скопируйте ячейку ниже на другом листе .Когда я запускаю его, я получаю только значение из ячейки в первой строке, которая находится в четырех столбцах справа от столбца B, и копирование вставляется в столбец A второго рабочего листа вплоть до последней возможной строки.Я думаю, что моя проблема в том, что цикл не работает (может быть, мне нужно включить счетчик, чтобы он находил соответствующее значение для каждого экземпляра, в котором я нахожу ключевое слово?), Или, возможно, я неправильно устанавливаю диапазоны и / или объединения.Попытка использовать смещение вместо ячеек заставляет Excel не отвечать.Любая помощь будет принята с благодарностью.

Я добавил пример изображения ниже банковского перевода, введенного в Excel.Я хочу, чтобы значение 4 столбца справа от «Перенос зарплаты» скопировалось на второй лист «Вывод».Я поставил X, чтобы заблокировать конфиденциальную информацию.Извините, что не смог понять, как получить изображение для показа здесь.

https://imgur.com/a/IjD3i0p

Я действительно опубликовал похожий вопрос об ошибке несоответствия типов пару часов назад, которая былапытаясь найти два отдельных значения, которые были смещены от ключевого слова, я просто пытаюсь упростить его сейчас, найдя одно значение смещения, и если я это выясню, то я могу сделать это для другого значения (одностолбец слева и строки внизу от ключевого слова) - моды, надеюсь, я разместил это все в порядке, мои извинения, если это не так.

Dim Ws As Worksheet
Dim rngCopy As Range, aCell As Range, bCell As Range
Dim strSearch As String

strSearch = "Salary Transfer"

Set Ws = Worksheets("Summary")

With Ws
Set aCell = .Columns(2).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell

    If rngCopy Is Nothing Then
        Set rngCopy = .Cells(aCell.Column + 4)
    Else
        Set rngCopy = Union(rngCopy, .Cells(aCell.Column + 4))
    End If

    Do
        Set aCell = .Columns(2).FindNext(After:=aCell)

        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do

            If rngCopy Is Nothing Then
                Set rngCopy = .Cells(aCell.Column + 4)
            Else
                Set rngCopy = Union(rngCopy, .Cells(aCell.Column + 4))
            End If
        Else
            Exit Do
    End If
    Loop
Else
    MsgBox SearchString & " not Found"
End If

If Not rngCopy Is Nothing Then rngCopy.Copy Sheets("Output").Columns(1)
End With

Answer 1

Я почти уверен, что это сделает то, что вы ищете:

Dim Ws As Worksheet, rCell As Range
Dim strSearch As String: strSearch = "Salary Transfer"

For Each rCell In Intersect(Ws.UsedRange, Ws.Range("B1").EntireColumn).Cells
    If UCase(rCell.Value2) = UCase(strSearch) Then
        Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Intersect(rCell.EntireRow, Ws.Columns(6)).Value
    End If
Next rCell

Существуют более эффективные способы использования поиска и массивов, но это просто поможет вам добраться до финиша.