Question

我正在寻找一种方法来复制和粘贴其他工作表中的超链接。

该程序应该工作的方式是您从列表中选择项目类别，然后所有以下列自动填写“类别”表单上的Vlookup检查

问题：复制和过去信息时需要保留超链接，我仍然是代码中的新手，目前还不知道如何使其工作。

我真的想保留VBA，因为代码是隐藏的，人们将无法使用它并且可以在特殊情况下在单元格上写字。

Sub Update()
 Dim calData As String
 Dim add As String
 Dim i, LastRow
 LastRow = Range("G" & Rows.Count).End(xlUp).Row
 For i = 3 To LastRow
 If Cells(i, "G").Value <> "" Then
    Range("Q" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 4, False)
    Range("R" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 6, False)
    'Set calData = Worksheets("Calendar").Range("R" & i)
    'add = "G:\Engineering\Engineering trainees (HUG)\Etalonnage\Procédures calibration\" & Data
        'With Worksheets("Calendar")
        '.Hyperlinks.add Anchor:=.Range("R" & i), _
        'Address:=add, _
        'TextToDisplay:=Data
        'End With
    Range("S" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 7, False)
    Range("T" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 8, False)
 End If
 End Sub

Answer 1

我认为你很亲密。请尝试以下代码。
请注意，尽量不要使用“添加”作为变量名称。它混淆了智能感知，我改为addr Q，R，S，T列不会更好地使用公式而不是固定值吗？除非您在G列中的单元格更改时有一个事件代码来调用此Sub。

Sub Update()
    Dim calData As String
    Dim addr As String
    Dim i As Long, LastRow As Long

    LastRow = Range("G" & Rows.Count).End(xlUp).Row
    For i = 3 To LastRow
        If Cells(i, "G").Value <> "" Then
            Range("Q" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 4, False)
            Range("R" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 6, False)

            calData = Worksheets("Calendar").Range("R" & i).Value ' Or .Text, depends on data
            addr = "G:\Engineering\Engineering trainees (HUG)\Etalonnage\Procédures calibration\" & calData
            With Worksheets("Calendar")
                .Hyperlinks.Add Anchor:=.Range("R" & i), Address:=addr, TextToDisplay:=calData
            End With

            Range("S" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 7, False)
            Range("T" & i).Value = Application.VLookup(Cells(i, "G"), Sheets("Category").Range("A2:H60"), 8, False)
        End If
    Next
End Sub

Vlookup与超链接 - VBA

1 个答案: