匹配并替换多张工作表中多个范围内的列中的字符串

Question

我正在尝试编写将搜索多个范围并匹配字符串前半部分的代码。 如果匹配为true，则他们会将范围内的单元格替换为列中的单元格。

我找到了这段代码，并进行了一些更改，以搜索不同工作表上多个范围内的多个列，并在字符串的第一部分匹配时替换掉。

我遇到的另一个问题是，例如，我需要它来搜索单元格中的一部分字符串

在范围中; 879841.42859-MD_42885来自专栏； 879841.42859-MD_43

我希望它匹配879841.42859-MD，然后将879841.42859-MD_43885替换为879841.42859-MD_43

' Matchandreplace1 Macro

'堆栈溢出的代码减少了，不涉及任何工作表。 '

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 ShTar1 = .Sheets("Sheet2")
    Set ShTar2 = .Sheets("Sheet3")
End With

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

'Set the lists to compare.
Set RefList = ShSrc.Range("A2:A" & SrcLRow)
Set TarList = ShTar1.Range("A2:A" & TarLRow)
Set TarList = ShTar2.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
        'set the value to match and highlight.
            TarColC.Value = RefColC.Value
            TarColC.Interior.ColorIndex = 4
        End If

    'Set boolean check to False.
    IsFound = False

Next RefCell
Application.ScreenUpdating = True

结束子

谢谢，

杰罗姆（Jerome） 一些小片段可以更好地描述

Answer 1

您粘贴的代码有很多语法错误。 Excel具有查找和替换功能，该功能可以替换找到的字符串。 您的要求是找到一个单元格的一部分（从源）并替换目标中的整个单元格

您必须在查找字符串之前和之后添加一个*，它将替换整个单元格。 假设您需要匹配“查找”字符串的前15个字母

    Sub FindReplaceAll1()
    Dim sht As Worksheet
    Dim fnd As Variant
    Dim rplc As Variant
    Dim Found As Range
    Dim Checkcol As Integer, rowcount As Integer, TcurrentRow As Integer, currentRow As Integer, Targrowcount As Integer
    Checkcol = 1 'Denotes A column

     Sheets("Sheet1").Select
    rowcount = Cells(Rows.Count, Checkcol).End(xlUp).Row
    For currentRow = 1 To rowcount
'Find the substring for which you need to match. Am taking first 15 characters.
    fnd = Left$(Cells(currentRow, Checkcol).Value, 15)
    rplc = Cells(currentRow, Checkcol).Value

    For Each sht In ActiveWorkbook.Worksheets
    If sht.Name = "Sheet2" Or sht.Name = "Sheet3" Then
    'Replace the whole string when a partial match is achieved
     sht.Cells.Replace what:="*" & fnd & "*", Replacement:=rplc, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    End If
    Next sht
    Next
    End Sub