VBA之批量添加删除超链接

xlbtlmy

已于 2022-04-24 22:55:44 修改

阅读量922

点赞数

分类专栏： VBA 文章标签： VBA

于 2022-04-24 20:44:03 首次发布

本文链接：https://blog.csdn.net/u011958166/article/details/124391215

版权

VBA 专栏收录该内容

4 篇文章 0 订阅

订阅专栏

此篇博客详细介绍了如何使用VBA在Excel中通过宏操作，将源工作表（如2月数据）与目标工作表（2月费用明细）进行数据对比，创建超链接。作者展示了如何设置源和目标范围，遍历并检查单元格内容，以及实现单元格间的精确匹配并插入超链接。

摘要由CSDN通过智能技术生成

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