VBA之批量添加删除超链接

2024年3月16日 141次阅读 来源: xlbtlmy 
Private Sub CommandButton1_Click()
    'Set source = Sheet1
    'Set target = Sheet2
    
    Set source = Worksheets("2月")
    Set target = Worksheets("2月费用明细")
    
    col_target = 1
    hl_name = "A"
    
    'MsgBox "Columns:" & source.UsedRange.Columns.Count & "Rows:" & source.UsedRange.Rows.Count
    'MsgBox "Columns:" & target.UsedRange.Columns.Count & "Rows:" & target.UsedRange.Rows.Count
    
    Dim MyArray()
    MyArray = Array(1, 3)
    
    array_len = (UBound(MyArray) - LBound(MyArray) + 1)
    
    For i = 0 To ((array_len / 2) - 1)
        col_min = MyArray(2 * i + 0)
        col_max = MyArray(2 * i + 1)
        
        For col_source = col_min To col_max
            For row_source = 1 To source.UsedRange.Rows.Count
                If source.Cells(row_source, col_source) <> "" Then
                    'MsgBox source.Name & "(" & col_source & "," & row_source & "):" & source.Cells(row_source, col_source)
                    
                    For row_target = 1 To target.UsedRange.Rows.Count
                        If target.Cells(row_target, col_target) <> "" Then
                            'MsgBox target.Name & "(" & row_target & "," & col_target & "):" & target.Cells(row_target, col_target)
                            
                            If source.Cells(row_source, col_source) = target.Cells(row_target, col_target) Then
                                'MsgBox "(" & col_source & "," & row_source & "):" & "(" & row_target & "," & col_target & "):" & target.Cells(row_target, col_target)
                                
                                source.Hyperlinks.Add Anchor:=source.Cells(row_source, col_source), Address:="", SubAddress:= _
                                target.Name & "!" & hl_name & row_target
                            End If
                        End If
                    Next
                End If
            Next
        Next
    Next
	ThisWorkbook.Save
End Sub

Private Sub CommandButton2_Click()
    Cells.Hyperlinks.Delete
    
    ThisWorkbook.Save
End Sub

End Sub

Private Sub CommandButton2_Click()
    Cells.Hyperlinks.Delete
    
    ThisWorkbook.Save
End Sub
    原文作者：xlbtlmy
    原文地址: https://blog.csdn.net/u011958166/article/details/124391215
    本文转自网络文章，转载此文章仅为分享知识，如有侵权，请联系博主进行删除。
点赞