Найти и заменить значение в столбце с уникальным идентификатором на нескольких листах - PullRequest
0 голосов
/ 20 июня 2019

Справочная информация: У меня есть файл с двумя листами (назовем их Sheet1 и Sheet2).

В Sheet1 у меня есть столбец A с уникальными идентификаторами и столбец B с некоторым текстом.

Пример данных от Sheet1:

А | B

1 | Яблоко

2 | Orange

3 | Лимонный

4 | Перец

В Sheet2 у меня есть столбец A с одинаковыми уникальными идентификаторами и столбец B с другим текстом.

Пример данных от Sheet2:

A | B

1 | Привет

2 | Как

3 | Есть

4 | Вы

Проблема: Я хотел бы иметь код VBA, который принимает один идентификатор из столбца A за раз от Sheet2, находит его в Sheet1 и перезаписывает (заменяет) текст в Sheet1 текстом из Sheet2.

Код: Я нашел этот код, который частично работает для меня, но вместо замены текста в столбце B в Sheet1 он заменяет идентификаторы в столбце A в Sheet1 текстом из Sheet2.

Sub multiFindandReplace()

Dim myList, myRange

Set myList = Sheets("Sheet2").Range("A2:B10")
'two column range with find/replace pairs
Set myRange = Sheets("Sheet1").Range("A2:B10")
'range to be searched and replace

For Each cel In myList.Columns(1).Cells
    myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 1).Value, LookAt:=xlWhole
Next cel

End Sub

Вопрос: Я понимаю, почему он это делает, но как я могу изменить его, чтобы заменить текст вместо идентификатора? По сути, я хочу, чтобы Sheet1 выглядел как Sheet2 в конце, но Sheet1 имеет больше строк, чем Sheet2, и, следовательно, строки не в том же порядке, и не все строки должны быть обновлены (что является почему мне нужно «найти и заменить»). В идеале этот код должен срабатывать при каждом изменении ячейки в столбце B.

Я также открыт для других идей кода или дополнений!

Спасибо!

1 Ответ

2 голосов
/ 20 июня 2019

Вы можете использовать Match, чтобы найти соответствующую строку на листе 1:

Sub multiFindandReplace()

    Dim myList As Range, myRange As Range, rw As Range, m

    Set myList = Sheets("Sheet2").Range("A2:B10")
    Set myRange = Sheets("Sheet1").Range("A2:B10")

    For Each rw In myList.Rows
        'Find match on sheet1
        m = Application.Match(rw.Cells(1).Value, myRange.Columns(1), 0)
        If Not IsError(m) Then
            'Got a match: replace in ColB
            myRange.Cells(m, 2).Value = rw.Cells(2).Value
        End If
    Next rw

End Sub

РЕДАКТИРОВАТЬ: при вызове из обработчика событий вы должны отключить события перед выполнением каких-либо обновлений листа, или вы можете попасть в ловушкубесконечная петля

Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error Goto haveError
    If Not Intersect(Target, Range("$B$2:$B$10")) Is Nothing Then 
        Application.EnableEvents = False
        multiFindandReplace 'name of my macro 
        Application.EnableEvents = True
    End If 
    Exit Sub
haveError:
    Application.EnableEvents = True

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...