Vlookup with Hyperlink - VBA

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

我觉得你很亲密。尝试下面的代码。
注意作为练习，尽量不要使用“add”作为变量名称。它搅乱了智能感知，我改为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