Можно ли написать макрос Excel для поиска и замены большого количества текстовых строк, которые находятся только в столбце с определенным заголовком?

Question

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

Я обыскал все вокруг и нашел метод для поиска столбца.что я ищу (в примере, он установлен как «АДРЕС 1»), а затем запустите поиск и заменить макросы, которые я также нашел.Однако, когда я объединил два макроса в один (возможно, неправильно), он выбирает правильные столбцы, а затем все равно запускает поиск и замену на всем листе.Посмотрите мой текущий код (я полностью любитель, когда дело доходит до такого рода вещей, поэтому любое объяснение будет полезно)

Sub Macro1()

    Dim sht As Worksheet
    Dim fndList As Variant
    Dim rplcList As Variant
    Dim x As Long
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "ADDRESS 1"
    Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)

    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If

    xRgUni.EntireColumn.Select

    Set myrange = ActiveWorkbook.xRgUni.EntireColumn.Select

    fndList = Array(" PLAZA ", " CIRCLE ")
    rplcList = Array(" PLZ. ", " CIR. ")

    For x = LBound(fndList) To UBound(fndList)
        For Each sht In ActiveWorkbook.Worksheets
            sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        Next sht

    Next x

End Sub

Answer 1

Я делаю некоторые предположения здесь, так как это код типа копирования / вставки. Но одно из этих предположений заключается в том, что xRgUni фактически является диапазоном, в котором был найден искомый заголовок. Если это правда, тогда это должно работать:

Sub Macro1()

    Dim sht As Worksheet
    Dim fndList As Variant
    Dim rplcList As Variant
    Dim x As Long
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "ADDRESS 1"
    Set xRg = Range("A1:P1").Find(xStr, , xlValues, xlWhole, , , True)

    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:P1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If

    xRgUni = xRgUni.EntireColumn

    fndList = Array(" PLAZA ", " CIRCLE ")
    rplcList = Array(" PLZ. ", " CIR. ")

    'Loop through all find/replace combos
    For x = LBound(fndList) To UBound(fndList)
        'Loop through each sheet in the workbook
        For Each sht In ActiveWorkbook.Worksheets
            'For the column defined by xRgUni in this sheet, do the find/replace
            sht.Range(xRgUni.AddressLocal).Replace What:=fndList(x), Replacement:=rplcList(x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        Next sht

    Next x

End Sub