2016-12-13 88 views
0

我目前正在尋找一種方法來複制和粘貼超鏈接從另一個工作表。Vlookup with Hyperlink - VBA

認爲該計劃是工作的方式是從列表中選擇一個項目類別,則以下所有的列自動填充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 

回答

0

我覺得你很親密。嘗試下面的代碼。
注意作爲練習,儘量不要使用「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