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

Question

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

Используемый мной код заменяет все вхождения слов в столбце A на столбец B.

Sub Sample2()
    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long

    Set thisWb = ThisWorkbook
    Set thisWs = thisWb.Sheets("Sheet1")

    Set NameListWB = Workbooks.Open("C:document.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet2")

    With thisWs
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 1 To lRow
            NameListWS.Columns(1).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(2).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(3).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(4).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(5).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Text, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(6).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(7).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
        For i = 1 To lRow
            NameListWS.Columns(8).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
    End With
End Sub

Answer 1

Sub Sample2()
    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long, columnNum As Long
    Dim maxColumnToRepalce As Integer
    Dim findRange As Range

    Set thisWb = ThisWorkbook
    Set thisWs = thisWb.Sheets("Sheet1")

    Set NameListWB = Workbooks.Open("C:document.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet2")

    maxColumnToRepalce = 8

    With thisWs
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For columnNum = 1 To maxColumnToRepalce
            For i = 1 To lRow
                Set findRange = NameListWS.Columns(columnNum).Find(What:=.Range("A" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      after:=.Cells(Columns(columnNum).Rows.Count, columnNum), _
                                      MatchCase:=False)
                If Not findRange Is Nothing Then
                    findRange.Value = .Range("B" & i)
                End If
            Next i
        Next columnNum
    End With
End Sub

Используйте метод Find, чтобы найти первое вхождение, затем выполните замену.Кстати, вы можете упростить код, добавив еще один цикл.