VBA Excel查找
我需要通过在Excel中使用VBA来查找完全匹配的帮助。 这是我的对象7问题。
目标 – 批量处理查找和replace单词。
这是我试图自动化的例行任务。 任务涉及find术语，然后用替代词replace它们。 例如，如果要find的术语是“微软”，我希望它被replace为“公司”。
虽然大部分的代码工作的限制是 – >如果有两个单词被发现，例如1.黄金2.黄金，然后用“金”代替“黄金”，黄金用“矿物在这里发生了什么，如果代码在任何地方find黄金，然后黄金首先被replace，最终产品看起来像这样。Metalen。有人可以帮忙吗？
Dim wksheet As Worksheet Dim wkbook As Workbook Dim fo_filesys As New Scripting.FileSystemObject Dim RegExpObject As Object Private Sub cmd_Start_Click() Dim lsz_dest_path As String Dim lsz_extn_to_use As String Dim lsz_filename As String Dim li_rowtoread As Integer Application.DisplayAlerts = False Application.ScreenUpdating = False lsz_dest_path = VBA.Strings.Trim(Cells(1, 6)) lsz_extn_to_use = VBA.Strings.Trim(Cells(2, 6)) Set RegExpObject = CreateObject("VBScript.RegExp") RegExpObject.IgnoreCase = True RegExpObject.Global = True lsz_filename = Dir(lsz_dest_path & "\" & lsz_extn_to_use) Do While lsz_filename <> "" Application.StatusBar = "Scrubbing " & lsz_filename Set wkbook = Workbooks.Open(lsz_dest_path & "\" & lsz_filename) For Each wksheet In wkbook.Worksheets wksheet.Activate li_rowtoread = 2 Do While Cells(li_rowtoread, 1) <> "" user_process_file Cells(li_rowtoread, 1), Cells(li_rowtoread, 2), lsz_filename li_rowtoread = li_rowtoread + 1 DoEvents Loop Next wksheet wkbook.Close True lsz_filename = Dir Loop Application.StatusBar = "" End Sub Sub user_process_file(lsz_searh_str As String, lsz_replace_str As String, filename As String) Dim myRange As Range Dim lo_tstream As TextStream Dim lo_reader_tstream As TextStream Dim lsz_file As String Dim lb_replaced As Boolean If fo_filesys.FileExists(filename & ".log") Then Set lo_reader_tstream = fo_filesys.OpenTextFile(filename & ".log", ForReading) lsz_file = lo_reader_tstream.ReadAll lo_reader_tstream.Close End If If lsz_searh_str = "RRD" Then ' MsgBox "Here" End If Set myRange = wksheet.Cells myRange.Cells.Find(What:="", After:=ActiveCell, lookat:=xlPart).Activate 'myRange.Replace What:=lsz_searh_str, Replacement:=lsz_replace_str, LookAt:=xlWorkbook, MatchCase:=False, searchorder:=xlByRows ', LookIn:=xlFormulas With myRange Set c = .Find(lsz_searh_str, LookIn:=xlValues, lookat:=xlPart) If Not c Is Nothing Then firstAddress = c.Address Do c.Value = CustomReplace(c.Value, lsz_searh_str, lsz_replace_str) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With Set lo_tstream = fo_filesys.OpenTextFile(filename & ".log", ForAppending, True) lb_replaced = myRange.Replace(What:=lsz_searh_str, Replacement:=lsz_replace_str, lookat:=xlWhole, MatchCase:=True, searchorder:=xlByRows) If lb_replaced = True Then lo_tstream.WriteLine lsz_replace_str lo_tstream.Close End If End Sub Function user_eval(lookfor As String, loc_data As String) As Boolean Dim lsz_val_at_loc As String If InStr(1, loc_data, lookfor) = 1 Then user_eval = True Else user_eval = False End If End Function Function CustomReplace(OriginalString As String, FindString As String, ReplaceString As String) RegExpObject.Pattern = "[^a-zA-Z0-9]*" & FindString & "[^a-zA-Z0-9]*" CustomReplace = RegExpObject.Replace(OriginalString, ReplaceString) End Function 我没有权限添加评论，所以回答我的唯一方法是：
你的正则expression式查找string[^a-zA-Z0-9]*和[^a-zA-Z0-9]* 。 尝试使用\bgold\w+\b匹配以黄金开始的单词和\bgold\b以完全匹配黄金。
虽然我迟到了，但也许会帮助有类似问题的人