我正在尝试编写一个代码来搜索多个范围并匹配字符串的前半部分。如果匹配为真,则它们将用列中的单元格替换范围中的单元格。
我找到了这段代码并进行了一些更改,以便在不同的工作表上搜索多个范围内的多个列,只需替换字符串的第一部分就匹配。
我遇到的另一个问题是我需要它来搜索单元格中的部分字符串,例如
在范围内; 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
谢谢,
答案 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