[游戏开发] VBA之批量添加删除超链接

开发: C++知识库 Java知识库 JavaScript Python PHP知识库人工智能区块链大数据移动开发嵌入式开发工具数据结构与算法开发测试游戏开发网络协议系统运维
教程: HTML教程 CSS教程 JavaScript教程 Go语言教程 JQuery教程 VUE教程 VUE3教程 Bootstrap教程 SQL数据库教程 C语言教程 C++教程 Java教程 Python教程 Python3教程 C#教程
数码: 电脑笔记本显卡显示器固态硬盘硬盘耳机手机 iphone vivo oppo 小米华为单反装机图拉丁

-> 游戏开发 -> VBA之批量添加删除超链接 -> 正文阅读

[游戏开发]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