如何合并两个将文本转为超链接的Excel VBA宏？

问题背景 #

现有两个功能一致的VBA宏，都是将单元格内容转为对应超链接，分别处理C列和F列：

Macro 1（处理C列） #

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, ra As Range
Application.ScreenUpdating = False
    Set ra = Range([C2], Range("C" & Rows.Count).End(xlUp))
For Each cell In ra.Cells
    If Len(cell) Then
    cell.Hyperlinks.Add cell, cell
End If    
Next cell
    Application.ScreenUpdating = True
End Sub

Macro 2（处理F列） #

Private Sub Worksheet_Change2(ByVal Target As Range)
Dim cell As Range, ra As Range
Application.ScreenUpdating = False
    Set ra = Range([F2], Range("F" & Rows.Count).End(xlUp))
For Each cell In ra.Cells
    If Len(cell) Then
    cell.Hyperlinks.Add cell, cell
End If    
Next cell
    Application.ScreenUpdating = True
End Sub

尝试用以下代码调用两个宏但无效：

Sub Macro3()
    Call Worksheet_Change
    Call Worksheet_Change2
End Sub

原因说明 #

Worksheet_Change是工作表事件过程，声明了ByVal Target As Range参数，调用时必须传递一个Range对象，直接Call Worksheet_Change会因缺少必要参数报错，所以这种调用方式不可行。

正确合并方案 #

方案一：修改原事件宏，同时处理C列和F列 #

直接修改Worksheet_Change事件宏，让它一次性处理多列，工作表内容变化时会自动触发处理：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range, ra As Range
    Dim targetCols As Variant
    Dim col As Variant
    
    Application.ScreenUpdating = False
    ' 定义需要处理的列，可按需添加更多列
    targetCols = Array("C", "F")
    
    For Each col In targetCols
        Set ra = Range(col & "2", Range(col & Rows.Count).End(xlUp))
        For Each cell In ra.Cells
            If Len(cell.Value) > 0 Then
                ' 先移除原有超链接，避免重复添加
                cell.Hyperlinks.Delete
                cell.Hyperlinks.Add Anchor:=cell, Address:=cell.Value
            End If
        Next cell
    Next col
    
    Application.ScreenUpdating = True
End Sub

说明：添加了cell.Hyperlinks.Delete避免重复添加超链接，同时用数组定义目标列，后续新增列只需修改数组即可。

方案二：封装通用处理逻辑，写独立宏 #

如果需要手动触发处理（而非依赖工作表变化事件），可以封装一个通用的处理函数，再写一个宏调用它：

' 通用处理函数：传入列名，处理该列的超链接
Private Sub ConvertToHyperlink(colName As String)
    Dim cell As Range, ra As Range
    Application.ScreenUpdating = False
    Set ra = Range(colName & "2", Range(colName & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        If Len(cell.Value) > 0 Then
            cell.Hyperlinks.Delete
            cell.Hyperlinks.Add Anchor:=cell, Address:=cell.Value
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

' 手动触发的宏，同时处理C列和F列
Sub ProcessBothColumns()
    ConvertToHyperlink "C"
    ConvertToHyperlink "F"
End Sub

使用时直接运行ProcessBothColumns宏即可。

内容的提问来源于stack exchange，提问作者Maria A