在Excel表格中查找/替换多个子字符串_Excel_Vba

在Excel表格中查找/替换多个子字符串

excel vba

在Excel表格中查找/替换多个子字符串,excel,vba,Excel,Vba,我正在将文本复制/粘贴到Excel中的一个单元格中，该单元格中有需要替换的特定子字符串，列表中约有4000行。我的文本/内容片段数与行数相等，需要手动复制/粘贴从本质上讲，特定的子字符串需要替换为相同的子字符串，并用HTML链接包装，但对于列表中出现的任何子字符串，都需要这样做例子：我有以下案文： Microsoft Excel是Microsoft为Windows、Mac OS X和iOS开发的电子表格。在第2页中，我有以下内容：；然后我需要excel输出上面的文本，指定的字符串替换

我正在将文本复制/粘贴到Excel中的一个单元格中，该单元格中有需要替换的特定子字符串，列表中约有4000行。我的文本/内容片段数与行数相等，需要手动复制/粘贴

从本质上讲，特定的子字符串需要替换为相同的子字符串，并用HTML链接包装，但对于列表中出现的任何子字符串，都需要这样做

例子：我有以下案文：

Microsoft Excel是Microsoft为Windows、Mac OS X和iOS开发的电子表格。

在第2页中，我有以下内容：；

然后我需要excel输出上面的文本，指定的字符串替换为以下格式的链接：

在本例中，它将输出以下内容：

Excel是由for、OS X和iOS开发的电子表格。

我不是excel专家，所以我无法找到解决方案。关于这一问题的一个答案对另一个问题提出了以下建议：；

=替换（A2，“作者”、“创作”）

但我不确定如何编辑它以包含所有字符串，而无需手动将每个字符串添加到公式中，因为这将当前逐个替换每个字符串

以前有人做过类似的事情吗？如果是这样，你是如何做到的？

在这种情况下，你面临的最大问题是误报。当一个词或短语可以在另一个词或短语中找到时，您可能会“重复处理”或错误地处理搜索词。要避免这种情况，请按长度降序处理每个术语，并分两步进行。首先，用一个绝对唯一的临时字符串替换搜索词，一旦所有的搜索词都被重新分配，返回并用实际的HTML锚元素替换临时字符串

模块1代码表

Option Explicit

Public Const csANCHOR As String = "<a href=""×LL×"">×FN×</a>"

Sub processBlurbs()
    Dim m As Long, w As Long
    Dim vWRDs As Variant, vBLRBs As Variant, vMSKs As Variant
    Dim rw As Long, r As Long, rndm As Long, str As String

    'appTGGL bTGGL:=False  'uncomment after testing

    getReplacements vWRDs
    'Debug.Print LBound(vWRDs, 1) & ":" & UBound(vWRDs, 1)
    'Debug.Print LBound(vWRDs, 2) & ":" & UBound(vWRDs, 2)

    With Worksheets("Blurbs")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion

            'replace with associated GUID for unique-per-term
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                'reset column B to column A values
                .Cells = .Offset(0, -1).Value2
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    Debug.Print vWRDs(w, 1) & " - " & vWRDs(w, 4)
                    .Replace what:=vWRDs(w, 1), lookat:=xlPart, MatchCase:=True, _
                             replacement:=vWRDs(w, 4)
                Next w
            End With

            'replace GUIDs with associated ANCHOR elements
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    .Replace what:=vWRDs(w, 4), lookat:=xlPart, MatchCase:=True, _
                             replacement:=Replace(Replace(csANCHOR, "×LL×", vWRDs(w, 2)), "×FN×", vWRDs(w, 1))
                Next w
            End With

        End With
    End With

    appTGGL
End Sub

Sub getReplacements(ByRef wrds As Variant)
    With Worksheets("Replacements")
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                .FormulaR1C1 = "=LEN(RC1)"
                .Value = .Value2
            End With
            With .Resize(.Rows.Count - 1, 1).Offset(1, 3)
                .Formula = "=getGuid()"
                .Value = .Value2
            End With
            .Cells.Sort key1:=.Columns(3), order1:=xlDescending, _
                        key2:=.Columns(1), order2:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                wrds = .Cells.Value2
            End With
        End With
    End With
End Sub

Function getGuid() As String
    Dim tl As Object
    Set tl = CreateObject("Scriptlet.TypeLib")
    getGuid = tl.Guid
    Set tl = Nothing
End Function

Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .EnableEvents = bTGGL
        .ScreenUpdating = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

选项显式
Public Const csANCHOR As String=“”
子进程blurbs（）
m和w一样长
尺寸VWDS作为变型，VBLRB作为变型，VMSK作为变型
尺寸rw为长，r为长，rndm为长，str为字符串
'appTGGL bTGGL:=False'在测试后取消注释
getReplacements vwds
'Debug.Print LBound（vwds，1）&“&UBound（vwds，1）
'Debug.Print LBound（vwdrs，2）&“&UBound（vwdrs，2）
带工作表（“宣传语”）
如果.AutoFilterMode，则.AutoFilterMode=False
带.Cells（1，1）.CurrentRegion
'替换为每个术语唯一的关联GUID
使用.Resize（.Rows.Count-1,1）.Offset（1,1）
'将B列重置为A列值
.Cells=.Offset（0，-1）.Value2
对于w=LBound（vwds，1）到UBound（vwds，1）
调试。打印vwds（w，1）和“-”以及vwds（w，4）
.替换内容：=vwds（w，1），lookat:=xlPart，MatchCase:=True_
替换：=VWDS（w，4）
下一个w
以
'用关联的锚元素替换GUID
使用.Resize（.Rows.Count-1,1）.Offset（1,1）
对于w=LBound（vwds，1）到UBound（vwds，1）
.替换内容：=vwds（w，4），lookat:=xlPart，MatchCase:=True_
替换：=替换（替换（csANCHOR，“×LL×”，vwds（w，2）），“×FN×”，vwds（w，1））
下一个w
以
以
以
appTGGL
端接头
子getReplacements（ByRef wrds作为变体）
带工作表（“替换件”）
带.Cells（1，1）.CurrentRegion
使用.Resize（.Rows.Count-1,1）.Offset（1,2）
.FormulaR1C1=“=LEN（RC1）”
.Value=.Value2
以
使用.Resize（.Rows.Count-1,1）.Offset（1,3）
.Formula=“=getGuid（）”
.Value=.Value2
以
.Cells.Sort key1:=.Columns（3），order1:=xlDescending_
键2:=.列（1），顺序2:=xl升序_
方向：=xltoptobttom，标题：=xlYes
使用.Resize（.Rows.Count-1、.Columns.Count）.Offset（1,0）
wrds=.Cells.Value2
以
以
以
端接头
函数getGuid（）作为字符串
作为对象的弱tl
Set tl=CreateObject（“Scriptlet.TypeLib”）
getGuid=tl.Guid
设置tl=无
端函数
子appTGGL（可选bTGGL为布尔值=真）
应用
.EnableEvents=bTGGL
.ScreenUpdating=bTGGL
.DisplayAlerts=bTGGL
.Calculation=IIf（bTGGL，XLCalculation自动，XLCalculation手动）
以
端接头

通过反复点击[F8]键完成此步骤，了解逻辑和流程

替换工作表

Option Explicit

Public Const csANCHOR As String = "<a href=""×LL×"">×FN×</a>"

Sub processBlurbs()
    Dim m As Long, w As Long
    Dim vWRDs As Variant, vBLRBs As Variant, vMSKs As Variant
    Dim rw As Long, r As Long, rndm As Long, str As String

    'appTGGL bTGGL:=False  'uncomment after testing

    getReplacements vWRDs
    'Debug.Print LBound(vWRDs, 1) & ":" & UBound(vWRDs, 1)
    'Debug.Print LBound(vWRDs, 2) & ":" & UBound(vWRDs, 2)

    With Worksheets("Blurbs")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion

            'replace with associated GUID for unique-per-term
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                'reset column B to column A values
                .Cells = .Offset(0, -1).Value2
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    Debug.Print vWRDs(w, 1) & " - " & vWRDs(w, 4)
                    .Replace what:=vWRDs(w, 1), lookat:=xlPart, MatchCase:=True, _
                             replacement:=vWRDs(w, 4)
                Next w
            End With

            'replace GUIDs with associated ANCHOR elements
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    .Replace what:=vWRDs(w, 4), lookat:=xlPart, MatchCase:=True, _
                             replacement:=Replace(Replace(csANCHOR, "×LL×", vWRDs(w, 2)), "×FN×", vWRDs(w, 1))
                Next w
            End With

        End With
    End With

    appTGGL
End Sub

Sub getReplacements(ByRef wrds As Variant)
    With Worksheets("Replacements")
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                .FormulaR1C1 = "=LEN(RC1)"
                .Value = .Value2
            End With
            With .Resize(.Rows.Count - 1, 1).Offset(1, 3)
                .Formula = "=getGuid()"
                .Value = .Value2
            End With
            .Cells.Sort key1:=.Columns(3), order1:=xlDescending, _
                        key2:=.Columns(1), order2:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                wrds = .Cells.Value2
            End With
        End With
    End With
End Sub

Function getGuid() As String
    Dim tl As Object
    Set tl = CreateObject("Scriptlet.TypeLib")
    getGuid = tl.Guid
    Set tl = Nothing
End Function

Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .EnableEvents = bTGGL
        .ScreenUpdating = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

简介工作表

Option Explicit

Public Const csANCHOR As String = "<a href=""×LL×"">×FN×</a>"

Sub processBlurbs()
    Dim m As Long, w As Long
    Dim vWRDs As Variant, vBLRBs As Variant, vMSKs As Variant
    Dim rw As Long, r As Long, rndm As Long, str As String

    'appTGGL bTGGL:=False  'uncomment after testing

    getReplacements vWRDs
    'Debug.Print LBound(vWRDs, 1) & ":" & UBound(vWRDs, 1)
    'Debug.Print LBound(vWRDs, 2) & ":" & UBound(vWRDs, 2)

    With Worksheets("Blurbs")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion

            'replace with associated GUID for unique-per-term
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                'reset column B to column A values
                .Cells = .Offset(0, -1).Value2
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    Debug.Print vWRDs(w, 1) & " - " & vWRDs(w, 4)
                    .Replace what:=vWRDs(w, 1), lookat:=xlPart, MatchCase:=True, _
                             replacement:=vWRDs(w, 4)
                Next w
            End With

            'replace GUIDs with associated ANCHOR elements
            With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
                For w = LBound(vWRDs, 1) To UBound(vWRDs, 1)
                    .Replace what:=vWRDs(w, 4), lookat:=xlPart, MatchCase:=True, _
                             replacement:=Replace(Replace(csANCHOR, "×LL×", vWRDs(w, 2)), "×FN×", vWRDs(w, 1))
                Next w
            End With

        End With
    End With

    appTGGL
End Sub

Sub getReplacements(ByRef wrds As Variant)
    With Worksheets("Replacements")
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, 1).Offset(1, 2)
                .FormulaR1C1 = "=LEN(RC1)"
                .Value = .Value2
            End With
            With .Resize(.Rows.Count - 1, 1).Offset(1, 3)
                .Formula = "=getGuid()"
                .Value = .Value2
            End With
            .Cells.Sort key1:=.Columns(3), order1:=xlDescending, _
                        key2:=.Columns(1), order2:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                wrds = .Cells.Value2
            End With
        End With
    End With
End Sub

Function getGuid() As String
    Dim tl As Object
    Set tl = CreateObject("Scriptlet.TypeLib")
    getGuid = tl.Guid
    Set tl = Nothing
End Function

Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .EnableEvents = bTGGL
        .ScreenUpdating = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

结果

Lorem dolor sit amet，Concertetur elit。


前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭前庭。


杜伊斯·特里斯蒂克·萨皮恩·诺波尔塔。


无马蒂斯扫描电镜端口。


前庭静脉曲张舌苔。


莫里斯精英酒店


酒后驾车。


这是我们的共同愿望。


纳拉姆多洛埃酒店


狮子座的万岁，不可能是一年前的万岁。


多尼克调味品


阿利奎姆·韦利特·乌兰科珀


利奥·埃吉特·麦格纳·埃利芬德馆长，波苏尔·维利特·廷西登。


埃尼安普尔维纳广场酒店


非同侧异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径异径


洛勒姆·莫里斯·坦普斯中的菲塞勒斯，拉奥里特·努克。


马萨奥纳雷的前庭应力调节器。


Proin lobortis quam，nec enim aliquet。

在这种情况下，您面临的最大问题是误报。当一个单词或短语可以在另一个单词或短语中找到时，您可以