Excel VBA - 使用正则表达式函数替换值

Question

我在excel中有一列没有格式化的图像链接。我在下面的原始数据中突出显示了图像链接

我需要一个excel VBA宏来转换数据：

我写了一个正则表达式http[s?]:\/\/.*(.png|.jpg)来模式匹配链接。样品：

我修改了here找到的函数来进行处理

Function ExtractURL(ByVal text As String) As String

Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Pattern = "(http[s?]:\/\/.*(.png|.jpg))"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(text)

If allMatches.Count <> 0 Then
    result = allMatches.Item(0).submatches.Item(0)
End If

ExtractURL = result

End Function

如何应用此功能替换A列中的值？

编辑：澄清/背景

我有1000多张图片链接。我只是简单地展示了5张图片，让这个例子变得简单明了。它只需要在A列之外工作，因为它是更大系列宏的一部分。

Answer 1

如果你想要的只是用网址替换A列，你可以试试这样的......

Sub ExtractURL()
Dim lr As Long
Dim Rng As Range, Cell As Range
Dim RE As Object    

lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A1:A" & lr)

Set RE = CreateObject("vbscript.regexp")

With RE
    .Pattern = "(http[s?]:\/\/.*(.png|.jpg))"
    .Global = False
    .IgnoreCase = True
End With

For Each Cell In Rng
    If RE.test(Cell.Value) Then
        Cell.Value = RE.Execute(Cell.Value)(0)
    End If
Next Cell
End Sub

如何安装新代码：

• 复制Excel VBA代码
• 选择要存储Excel VBA代码的工作簿
• 按Alt+F11打开Visual Basic编辑器
• 在VB编辑器中，选择Insert - ＆gt; Module
• 将复制的代码粘贴到打开的代码窗口
• 将工作簿另存为启用宏的工作簿。

运行Excel VBA代码：

• 按Alt+F8打开宏列表

• 选择宏ExtractURL

• 点击“运行”。

注意： 如果要将输出放在另一列中，比如列B，请改用此行...

Cell.Offset(0, 1).Value = RE.Execute(Cell.Value)(0)

Answer 2

我一直被告知regexp可以减慢速度

所以这里是一个非RegExp解决方案：

Sub main()
    With Range("A1", Cells(Rows.Count, 1).End(xlUp))
        .Replace what:="*https", replacement:="https", lookat:=xlPart
        .Replace what:=".JPG*", replacement:=".JPG", lookat:=xlPart
    End With
End Sub

并且你必然需要一个功能：

Function ExtractURL(text As String)    
    ExtractURL = Mid(Left(text, InStrRev(text, ".JPG", , vbTextCompare) + 3), InStr(1, text, "https", vbTextCompare))
End Function

Answer 3

来自我曾写过的旧指令

输入用户定义函数（UDF）：

• alt-F11 打开Visual Basic编辑器。
• 确保您的项目在Project Explorer窗口中突出显示。
• 然后，从顶部菜单中选择Insert/Module和 将代码粘贴到打开的窗口中。

要使用此用户定义函数（UDF），请在某个单元格中输入类似ExtractURL(cell_ref)的公式。

Answer 4

根据我的原始帖子，这就是我使用的。使用我的问题陈述中定义的extractURL函数

Sub MainTest()

Range("A1").Activate
Do
    If ActiveCell.Value = "" Then Exit Do
    ActiveCell.Offset(1, 0).Activate
    argCounter = argCounter + 1
Loop

For row = 1 To argCounter + 1
    Cells(row, 1).Value = ExtractURL(Cells(row, 1).Value)
Next row

End Sub

1. 模块alt+f11
中的转储代码
2. 保存
3. 查看宏→MainTest