VBA之批量添加删除超链接

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
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值