VBA - Ошибка несоответствия типов при копировании ячеек, связанных с определенным ключевым словом в столбце - PullRequest
0 голосов
/ 28 января 2019

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

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

Set rngCopy2 = .Rows(.Cells(aCell.Row) + 3) & (.Cells(aCell.Column) - 1)

Я пытался изменить .Rows на .Columns, где это aCell.Column, но это, похоже, не работает.Я положительно озадачен и был бы признателен за любую помощь, которую кто-то может оказать.

Обратите внимание, что я внес небольшие изменения в синтаксис кода и добавил. Ячейки перед aCell при настройке диапазонов.

Кроме того, в качестве отдельного и быстрого вопроса, если у меня есть имяВ ячейке, длина которой может быть от 5 до 18 символов, но за которой следует такая константа, как «Персонал АВС», есть ли способ поднять все в этой ячейке, пока не появится надпись «Персонал АВС»?

Dim ws As Worksheet
Dim rngCopy As Range, aCell As Range, bCell As Range
Dim rngCopy2 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 = .Rows(.Cells(aCell.Column + 4))
            Set rngCopy2 = .Rows(.Cells(aCell.Row) + 3) & (.Cells(aCell.Column) - 1)
        Else
            Set rngCopy = Union(rngCopy, .Rows(.Cells(aCell.Column + 4)))
            Set rngCopy2 = Union(rngCopy2, .Rows(.Cells(aCell.Row + 3) & .Cells(aCell.Column - 1)))
        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 = .Rows(.Cells(aCell.Column + 4))
                    Set rngCopy2 = .Rows(.Cells(aCell.Row) + 3) & (.Cells(aCell.Column) - 1)
                Else
                     Set rngCopy = Union(rngCopy, .Rows(.Cells(aCell.Column + 4)))
                    Set rngCopy2 = Union(rngCopy2, .Rows(.Cells(aCell.Row + 3) & .Cells(aCell.Column - 1)))
                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").Rows(1)
    If Not rngCopy2 Is Nothing Then rngCopy2.Copy Sheets("Output").Rows(2)
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...