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 Numbers：

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

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

1 个答案: