使用'分隔符'在VBA中集中更多單元格

Question

我正嘗試使用VBA代碼從GCmap.com生成地圖。 我在一列中有一長串機場對。 ）

「http://www.gcmap.com/map?P=」 &（calue中。細胞（1.51））& 「％0D％0A」 &（calue中。細胞（2.51 &等：超鏈接的，這將產生在地圖將格式。 ..

'的0D％0A％ - 是一個需要被值

的問題是，這個名單是超鏈接的很長，只是做簡單的循環會造成巨大的長度之間的分隔符（有時太長的來生成地圖）所以它必須是類似 if if valueOfFirstCell = ValueOfCellBellow then 「跳到下一個

我已經試過這（可能是有史以來最嚴重編寫的代碼，但請注意，我只是初學者在VBA :)

Sub hyperlinkgenerator() 

Dim separator As String ' declared the 'separator' value 
separator = "%0d%0a" 
Dim datarow, irow As Integer 
Dim myval as Range 

With Sheets("Direct flights") 

    Set myval = .Cells(datarow, 51) 

    Do While myval <> ""  ' do until last empty row 

Dim Value1 As String 
Value1 = Sheets("Direct flights").Cells(datarow, 51) ' declare value of the first cell 

Dim Value2 As String 

Value2 = Sheets("Direct flights").Cells(datarow + 1, 51) ' declare value of cell bellow 

If Value1 = Value2 Then 

datarow = datarow + 1 

Else: 'enter Value1 in hyperlink that is followed by & separator 
'also the hyperlink must start with: http://www.gcmap.com/map?P= 
' and end with %0d%0a&MS=wls&MR=540&MX=720x360&PM=* 

End If 

datarow = datarow + 1 

Loop 

End With 

End Sub 

最後的鏈接看起來像：

http://www.gcmap.com/map?P=LGW-AMS%0d%0aAMS-LHR%0d%0aLCY-AMS%0d%0aLUX-AMS%0d%0aBRE-AMS%0d%0aCWL-AMS%0d%0aNUE-AMS%0d%0aAMS-JFK%0d%0a&MS=wls&MR=540&MX=720x360&PM= *

我不知道如何保持循環向超鏈接添加新文本和新文本。此外，超鏈接應該由用戶點擊按鈕時生成並打開（這很容易實現）。

非常感謝提前！

Answer 1

試試這個：

Sub hyperlinkgenerator() 
    Dim thisVal As String 
    Dim nextVal As String 
    Dim currentRow As Long 
    Dim hyperlink As String 

    currentRow = 1 ' or whatever the first row is 
    hyperlink = "" 

    With Sheets("Direct flights") 
     Do While True 
      thisVal = .Cells(currentRow, 1).Value 
      nextVal = .Cells(currentRow + 1, 1).Value 

      If thisVal = "" Then 
       Exit Do 
      ElseIf thisVal <> nextVal Then 
       hyperlink = hyperlink & thisVal & "%0d%0a" 
      End If 

      currentRow = currentRow + 1 
     Loop 

    End With 

    hyperlink = "http://www.gcmap.com/map?P=" & hyperlink & "&MS=wls&MR=540&MX=720x360&PM=" 

    MsgBox hyperlink 
End Sub