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

时间:2017-10-14 15:13:42

标签: excel vba excel-vba

我正在尝试编写一个代码来搜索多个范围并匹配字符串的前半部分。如果匹配为真,则它们将用列中的单元格替换范围中的单元格。

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

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

在范围内; 879841.42859-MD_42885 从专栏; 879841.42859-MD_43

我希望它与879841.42859-MD匹配,然后用879841.42859-MD_43替换879841.42859-MD_43885

' 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

End Sub

谢谢,

杰罗姆 A few snips to better describe

1 个答案:

答案 0 :(得分:0)

您粘贴的代码有很多语法错误。 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