遍歷多個範圍與每個，不想有5公里長碼

Question

功能產生（）

Dim varLookup As Collection 
Dim sheetOutput As Worksheet 
Dim sheetVariables As Worksheet 
Dim intRow As Integer 
Dim intCol As Integer 

intRow = 1 
intCol = 1 

Set sheetVariables = Worksheets("variables") 

Dim rngCountries As Range 
Set rngCountries = sheetVariables.Range("A2:A250") 

Dim rngCities As Range 
Set rngCities = sheetVariables.Range("D1:D4195") 

Dim rngAirports As Range 
Set rngAirports = sheetVariables.Range("C1:C4195") 

Set varLookup = New Collection 
varLookup.Add "A1:A10", "[country]" 

Dim countryList(1) As String 
countryList(0) = "US" 
countryList(1) = "FR" 

Dim strOuput As String 
strOutput = "From UK to " 

Dim strCombo As String 
strCombo = "From UK to [Country]" 

'For every country in list 
Set sheetOutput = Worksheets("keyphrases") 
For Each c In rngCountries.Cells 
    strOutput = "From UK to " & c.Value 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 
For Each c In rngCountries.Cells 
    strOutput = "From " & c.Value & " to UK" 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 

'For every city in list 
For Each c In rngCities.Cells 
    strOutput = "From UK to " & c.Value 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 
For Each c In rngCities.Cells 
    strOutput = "From " & c.Value & " to UK" 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 

'For every airport in list 
For Each c In rngAirports.Cells 
    strOutput = "From UK to " & c.Value 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 
For Each c In rngAirports.Cells 
    strOutput = "From " & c.Value & " to UK" 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 
' From every City to Country [UK] 
For Each c In rngCities.Cells 
    strOutput = "From " & c.Value & " to UK" 
    sheetOutput.Cells(intRow, intCol).Value = strOutput 
    intRow = intRow + 1 
Next 

For x = LBound(countryList) To UBound(countryList) 'define start and end of array 
    strOutput = "From UK to " & countryList(x) 
Next x ' Loop! 

Set sheetOutput = Nothing 

端功能

，所以我已經得到了2公里長碼，我仍然有大約另外15個組合可以做。我如何使它更容易？我不想複製和粘貼其他15個組合。

非常感謝

Answer 1

寫子程序傳遞範圍如下：

Sub PrintRange (r As Range) 
    'For every city in list 
    For Each c In r.Cells 
     strOutput = "From UK to " & c.Value 
     sheetOutput.Cells(intRow, intCol).Value = strOutput 
     intRow = intRow + 1 
    Next 
    For Each c In r.Cells 
     strOutput = "From " & c.Value & " to UK" 
     sheetOutput.Cells(intRow, intCol).Value = strOutput 
     intRow = intRow + 1 
    Next 
End Sub 

您需要調用如下：

PrintRange rngCities 

爲了避免硬編碼的範圍，你可以使用命名範圍。