根据A列中的匹配索引替换C列中的字符串

Question

对此事我感激不尽。我试图在VBA中创建一个Excel 2010宏，它将逐行读取一个电子表格中的字符串，然后搜索另一个电子表格以查看该值是否存在于字符串列中。

如果/当在A列中找到匹配的字符串时，我想将原始电子表格的C列中的字符串与正在搜索的电子表格的C列中的字符串进行比较。如果两个字符串相同，我想继续回到A列搜索并继续。

如果字符串不同，我想覆盖正在搜索的电子表格的C列中的字符串。我还想在搜索到的电子表格中突出显示此更改。

如果在搜索电子表格的A列中找不到匹配的字符串，那么我想将原始电子表格的行复制到搜索到的电子表格中并突出显示它。

这是我到目前为止所拥有的，但我似乎无法让它正常工作：

Sub SearchRows()
Dim bottomA1 As Integer
bottomA1 = Sheets("Original Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim bottomA2 As Integer
bottomA2 = Sheets("Searched Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row
Dim rng1 As Range
Dim rng2 As Range
Dim x As Long
Dim y As Long
Dim foundColumnA As Range
Dim foundColumnC As Range
For Each rng1 In Sheets("Original Spreadsheet").Range("A2:A" & bottomA1)
    With Sheets("Searched Spreadsheet").Range("A2:A" & bottomA2)
        Set foundColumnA = .Find(what:=rng1, _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
            For Each rng2 In Sheets("Original Spreadsheet").Range("E2:E" & bottomA1)
                With Sheets("Searched Spreadsheet").Range("E2:E" & bottomA2)
                        Set foundSize = .Find(what:=rng2, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=True)
                If foundColumnC Is Nothing Then
                        bottomE2 = Sheets("Column C Changes").Range("E" &     Rows.Count).End(xlUp).Row
                        y = bottomA2 + 1
                        rng2.EntireRow.Copy Sheets("Column C Changes").Cells(y, "A")
                        Sheets("Column C Changes").Cells    (y, "A").EntireRow.Interior.ColorIndex = 4
                End If
            End With
        Next rng2
    If foundTag Is Nothing Then
        bottomA2 = Sheets("Column A Changes").Range("A" & Rows.Count).End(xlUp).Row
        x = bottomA2 + 1
        rng1.EntireRow.Copy Sheets("Column A Changes").Cells(x, "A")
        Sheets("Column A Changes").Cells(x, "A").EntireRow.Interior.ColorIndex = 3
    End If
End With
Next rng1
End Sub

Answer 1

我认为您可以使用此代码。 未找到的值将添加到目标表的末尾。 差异用蓝色（如果需要，可以更改）背景颜色签名。

Sub copy_d()
Dim r1 As Long, rfound, vfound
Dim w1, w2, v, lastR As Long, lastC As Long
Set w1 = Sheets("sheet1") ' change the origin sheet at will
Set w2 = Sheets("sheet2") ' change the destination sheet at will
r1 = 1 ' assuming data start in row 1, change it if not
Do While Not IsEmpty(w1.Cells(r1, 1))
 v = w1.Cells(r1, 1)
 rfound = Application.Match(v, w2.Columns(1), 0) ' look for value
 If Not IsError(rfound) Then ' found it?
  vfound = w2.Cells(rfound, 3)
  If w1.Cells(r1, 3) <> vfound Then ' value in column C is different?
   w2.Cells(rfound, 3) = w1.Cells(r1, 3) ' update based on origin sheet
   lastC = w2.Cells(rfound, 1).End(xlToRight).Column
   w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5
  End If
 Else
  lastR = w2.Cells(1, 1).End(xlDown).Row + 1
  w1.Rows(r1).copy Destination:=w2.Rows(lastR) ' copy to last row of dest sheet
  lastC = w2.Cells(lastR, 1).End(xlToRight).Column
  w2.Range(w2.Cells(lastR, 1), w2.Cells(lastR, lastC)).Interior.ColorIndex = 5
 End If
 r1 = r1 + 1
Loop
End Sub

Answer 2

你实际上有太多的代码，但它们并没有干净利落地设置。尽可能多地限定许多东西，使其更清洁，并尝试与您的风格保持一致。这样您就可以尽可能地识别错误。

无论如何，关于代码。根据上面的详细信息，您需要的基本逻辑如下：

1. 检查Sheet1!A中的字符串是否在Sheet2!A。
2. 如果找到，请比较Column C值。
   • 如果Column C值不同，请将Sheet2的值设置为Sheet1中的值并突出显示。
   • 否则，退出。
3. 如果找不到，请将整行复制到Sheet2并突出显示。

既然我们已经写下来了，那就更简单了！ ：）

请查看我的截图以查看我的设置：

<强>截图：

<强> Sheet 1中：



<强> Sheet 2中：



请注意，对于Sheet2，我没有BK207开始。 ;）现在，进入代码。

<强> CODE：

Sub LoopMatchReplace()

    Dim ShSrc As Worksheet, ShTar As Worksheet
    Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long
    Dim RefList As Range, TarList As Range, RefCell As Range, RefColC
    Dim TarCell As Range, TarColC As Range
    Dim IsFound As Boolean
    Dim ToFind As String

    With ThisWorkbook
        Set ShSrc = .Sheets("Sheet1")
        Set ShTar = .Sheets("Sheet2")
    End With

    'Get the last rows for each sheet.
    SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row
    TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row

    'Set the lists to compare.
    Set RefList = ShSrc.Range("A2:A" & SrcLRow)
    Set TarList = ShTar.Range("A2:A" & TarLRow)

    'Initialize boolean, just for kicks.
    IsFound = False

    'Speed up the process.
    Application.ScreenUpdating = False

    'Create the loop.
    For Each RefCell In RefList

        ToFind = RefCell.Value

        'Look for the value in our target column.
        On Error Resume Next
        Set TarCell = TarList.Find(ToFind)
        If Not TarCell Is Nothing Then IsFound = True
        On Error GoTo 0

        'If value exists in target column...
        If IsFound Then
            'Compare the Column C of both sheets.
            Set TarColC = TarCell.Offset(0, 2)
            Set RefColC = RefCell.Offset(0, 2)
            'If they are different, set the value to match and highlight.
            If TarColC.Value <> RefColC.Value Then
                TarColC.Value = RefColC.Value
                TarColC.Interior.ColorIndex = 4
            End If
        Else 'If value does not exist...
            'Get next empty row, copy the whole row from source sheet, and highlight.
            NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1
            RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow)
            ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3
        End If

        'Set boolean check to False.
        IsFound = False

    Next RefCell

    Application.ScreenUpdating = True

End Sub

请阅读代码块的注释，以便了解我正在做的事情。另外，请注意我对所有内容进行限定并以非常干净的方式正确设置它们的方式。清洁代码是50％的优秀代码。

检查以下屏幕截图，查看运行代码后的结果。

结束结果：



请注意最后添加的行以及C列中更改的值。我没有突出显示整行，因为我认为这是不好的做法和混乱，但是由您来更改相应的行和值以适合您的品尝最终结果。

如果有帮助，请告诉我们。