根据列A中的匹配索引替换列C中的字符串 [英] Replace a string in Column C based on matching index in Column A

问题描述

我很乐意就这件事情提供任何帮助。我试图在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范围（A2：A& bottomA1）$ b $ ; bottomA2）
设置foundColumnA = .Find（what：= rng1，_ 
之后：=。Cells（.Cells.Count），_ 
 LookIn：= xlValues，_ 
 LookAt：= xlWhole，_ 
 SearchOrder：= xlByRows，_ 
 SearchDirection：= xlNext，_ 
 MatchCase：= False）
对于每个rng2 In Sheets（Original Spreadsheet）。Range（E2：E& bottomA1）
 With Sheets（Searched Spreadsheet）。Range（E2：E& bottomA2）
 Set foundSize = .Find（what：= rng2，_ 
 After：=。单元格（.Cells.Count），_ 
 LookIn：= xlValues，_ 
 LookAt：= xlWhole，_ 
 SearchOrder：= xlByRows，_ 
 SearchDirection：= xlNext，_ 
 MatchCase：= True）
如果foundColumnC是Nothing然后
 bottomE2 = Sheets（Column C Changes）。Range（E& Rows.Count）.End（xlUp）.Row 
y = bottomA2 + 1 
 rng2.EntireRow.Copy表（列C更改）单元格（y，A）
表格（列C更改）单元格，A）EntireRow.Interior.ColorIndex = 4 
结束如果
结束
下一个rng2 
如果foundTag不是，然后
 bottomA2 = Sheets（Column A Changes）。Range（A& Rows.Count）.End（xlUp）.Row 
x = bottomA2 + 1 
 rng1.EntireRow.Copy表（Column A Changes）。单元格（x，A）
表格（Column A Changes）。Cells（x，A）。EntireRow.Interior.ColorIndex = 3 
 End If 
 End With 
 Next rng1 
 End Sub 
  

解决方案

你实际上有太多的代码，但是没有设置干净地尽可能多地批准很多东西，因此它更干净，并尝试与您的风格保持一致。这样就可以尽可能地确定错误。

无论如何，对代码。您所要的基本逻辑如下，基于上述细节：

1. 检查 Sheet1中的字符串！ 在 Sheet2！A 。


2. 如果找到，比较列C 值。
   
   
   
   
   • 如果列C 值不同，设置值 Sheet2 to Sheet1 并突出显示。
   
   
   • 否则退出。
   
   
   
   
   • 如果找不到，请将整行复制到 Sheet2 并突出显示。
   
   

现在我们已经写下来了，这更简单！ ：）

请检查我的设置屏幕截图：

屏幕保护程序：

Sheet1：

Sheet2：

请注意，对于 Sheet2 ，我没有 BK207 起。

代码：

  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 
设置ShSrc = .Sheets（Sheet1）
设置ShTar = .Sheets（Sheet2）
结束
 
'获取每个工作表的最后一行。 
 SrcLRow = ShSrc.Range（A& Rows.Count）.End（xlUp）.Row 
 TarLRow = ShTar.Range（A& Rows.Count）.End（xlUp） .Row 
 
'设置列表进行比较。 
 Set RefList = ShSrc.Range（A2：A& SrcLRow）
 Set TarList = ShTar.Range（A2：A& TarLRow）
 
'初始化布尔，只是为了踢。 
 IsFound = False 
 
'加快进程。 
 Application.ScreenUpdating = False 
 
'创建循环。 
对于RefList中的每个RefCell 
 
 ToFind = RefCell.Value 
 
'查找我们的目标列中的值。 
 On Error Resume Next 
 Set TarCell = TarList.Find（ToFind）
如果不是TarCell，则IsFound = True 
出现错误GoTo 0 
 
 '如果值存在于目标列中... 
如果IsFound然后
'比较两个表的列C。 
设置TarColC = TarCell.Offset（0，2）
设置RefColC = RefCell.Offset（0,2）
'如果它们不同，请将该值设置为匹配并突出显示。 
如果TarColC.Value<> RefColC.Value然后
 TarColC.Value = RefColC.Value 
 TarColC.Interior.ColorIndex = 4 
结束If 
否则如果值不存在... 
 '获取下一个空行，从源表复制整行，并突出显示。 
 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 
 
'将布尔检查设置为False。 
 IsFound = False 
 
下一个RefCell 
 
 Application.ScreenUpdating = True 
 
 End Sub 
  

请仔细阅读代码块的注释，以便了解我在做什么。另外，请注意我已经对所有内容进行了限定，并以非常干净的方式正确设置。清洁代码是50％的好代码。

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

END RESULT：

注意列C中添加的行和更改的值。我没有将整行突出显示，因为我认为这是不好的做法和凌乱，但是由你自己改变各自的线条和价值，以满足您的最终结果。

让我们知道这是否有帮助。

I would appreciate any help on this matter. I am trying to create an Excel 2010 macro in VBA that will read strings in one spreadsheet row by row, and then search another spreadsheet to see if the value exists in a column of strings.

If/When it finds a matching string in column A, I would like to compare the string in column C of the original spreadsheet with the string in Column C of the spreadsheet being searched. If both strings are the same, I would like to move on back to the column A search and continue.

If the strings are different I would like to overwrite the string in Column C of the spreadsheet being searched. I would also like to highlight this change on the searched spreadsheet.

If no matching string is found in column A of the search spreadsheet, then I want to copy the row of the original spreadsheet into the searched spreadsheet and highlight it.

Here's what I have so far, but I can't seem to get it to work properly:

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

解决方案

You actually have too much code, but they're not set up cleanly. Qualify a lot of things as much as possible so it's cleaner, and try to be consistent with your style. This way you can identify the error as much as possible.

Anyway, on to the code. The basic logic you want is as follows, based on the details above:

1. Check if a string in Sheet1!A is in Sheet2!A.
2. If found, compare Column C values.
   • If Column C values are different, set value of Sheet2 to that in Sheet1 and highlight.
   • Else, exit.
3. If not found, copy whole row to Sheet2 and highlight.

Now that we have that written down, it's simpler! :)

Please check my screenshots for my set-up:

SCREENSHOTS:

Sheet1:

Sheet2:

Note that for Sheet2, I don't have BK207 onwards. ;) Now, onto the code.

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

Kindly read the comments for the codeblocks so you get an understanding of what I'm doing. Also, note the way that I have qualified everything and properly set them up in a very clean way. Clean code is 50% good code.

Check the following screenshot to see the results after running the code.

END RESULT:

Note the added rows at the end and the changed values in Column C. I did not have the whole row highlighted as I believe that's bad practice and messy, but it's up to you to change the respective lines and values to suit your taste for the end result.

Let us know if this helps.

这篇关于根据列A中的匹配索引替换列C中的字符串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！