VBA宏从一个单元格提取超链接到另一个单元格

Question

我有以下代码从单元格中提取超链接，然后将其移动到相邻单元格。我的目标是能够指定多个列以及单元格应移动到的确切列。

如您所见，代码从列 B1 到 B2000 获取超链接值并将超链接值复制到列 C (cll.Column + 1)，但我想指定要将超链接复制到的确切列。

例如:我希望所有超链接都从 B 复制到 G； D到F；和 E 到 H。

Sub hyper()
 Dim sht As Worksheet: Set sht = Worksheets("Sheet1")
 Dim cll As Range
 For Each cll In sht.Range("B2:B2000")
 If cll.Hyperlinks.Count > 0 Then
     sht.Cells(cll.Row, cll.Column + 1).Value = cll.Hyperlinks(1).Address
 End If
   Next cll
 msgbox "The macro has completed running"
 End Sub

我对 VBA 宏不太了解，因此不胜感激。非常感谢!
〜亚当

Answer 1

Select Case可以改进你的代码。只要确保您按照自己的意愿修复魔数(Magic Number):

Sub Hyper()
    Dim sht As Worksheet: Set sht = Worksheets("Sheet1")
    Dim cll As Range
    For Each cll In sht.Range("B2:H2000")
        If cll.Hyperlinks.Count > 0 Then
            Select Case cll.Column

            Case Range("A1").Column:
                sht.Cells(cll.Row, 15).Value = cll.Hyperlinks(1).Address
            Case Range("E1").Column
                sht.Cells(cll.Row, 20).Value = cll.Hyperlinks(1).Address
            Case Range("G1").Column
                sht.Cells(cll.Row, 25).Value = cll.Hyperlinks(1).Address

            End Select
        End If
    Next cll
    MsgBox "The macro has completed running"
End Sub