5

Я хочу запустить поиск и замену нескольких значений в диапазоне Excel со значениями из 2 столбцов: A с исходным словом; Б с переводом. Я уже нашел код VBA, чтобы заставить его работать на 50%, но этот код запускает его на всей рабочей странице.

В идеале я хотел бы иметь возможность запустить его только на выбранном диапазоне. Дополнительный бонус был бы, если бы я мог также выбрать диапазон поиска.

Это то, что я использую это далеко. Спасибо за вашу помощь!

Sub abbrev()
            Dim abvtab() As Variant
            Dim ltsheet As Worksheet
            Dim datasheet As Worksheet
            Dim lt As Range

            'Change Lookup to the sheet name with your lookup table.
            Set ltsheet = Sheets("Lookup")

            'Change Data to the sheet name with your data.
            Set datasheet = Sheets("Data")

            'Change A2 to the top left cell (not the header) in your lookup table.
            'Change B2 to top right cell.
            Set lt = ltsheet.Range("A1", ltsheet.Range("B1").End(xlDown))

            abvtab = lt

            For i = 1 To UBound(abvtab)
                datasheet.Cells.Replace What:=abvtab(i, 1), Replacement:=abvtab(i, 2), LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                    ReplaceFormat:=False
            Next i
End Sub

1 ответ1

3

Excel Multi Replace

  1. Откройте редактор VBA (Alt+F11) и вставьте приведенный ниже макрос в любое место
  2. Установите диапазон поиска из двух столбцов: 1-й столбец - это значение для поиска, 2-й - значение для замены
  3. Выберите диапазон ввода, в котором значения должны быть заменены, как показано на первом рисунке.
  4. Выполнить макрос (Alt+F8).

Макрос спрашивает, где находится ваш диапазон поиска. Сначала имя листа, затем адрес диапазона поиска. Введите только первый столбец, например, A1:A2 для примера ниже.

Вот и все. Теперь макрос начинает перебирать все правила замены и применяет их как
обычный поиск и замена Excel (Ctrl+H) на выбранный диапазон ввода.

Input range            Replace rules               Input range after macro

Sub MultiReplace()
On Error GoTo errorcatch
Dim arrRules() As Variant

    strSheet = InputBox("Enter sheet name where your replace rules are", _
        "Sheet name", "Sheet1")
    strRules = InputBox("Enter address of replaces rules." & vbNewLine & _
        "But only the first column!", "Address", "A1:A100")

    Set rngCol1 = Sheets(strSheet).Range(strRules)
    Set rngCol2 = rngCol1.Offset(0, 1)
    arrRules = Application.Union(rngCol1, rngCol2)

    For i = 1 To UBound(arrRules)
        Selection.Replace What:=arrRules(i, 1), Replacement:=arrRules(i, 2), _
            LookAt:=xlWhole, MatchCase:=True
    Next i

errorcatch:
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .