Excel一个单元格到多个公式（我意识到这不可能）

首先，我想说的是，我知道这是极其困难或不可能的。

我有数据（来自Wikipedia，在航空公司和目的地列表中的任何机场上），一列是航空公司名称，另一列是由逗号分隔的目的地列表，偶尔还会列出一些其他信息。

我需要的是将每个目的地都放在单独的行中，旁边是航空公司的名称，并在第三列中提供额外的信息（包机，季节性，“开始...”，参考）。

我将使用多个Wikipedia表反复进行此操作。我正在Kumu.io上创建路线图。可以的是，任何解决方案都不能完全解决所有问题，我只需要一些接近的东西，因为我无法手工完成所有事情。如果您需要更多信息，请告诉我。感谢您的协助，这确实是一个了不起的资源。

数据是这种格式

我需要它看起来像

您是否真的有超级链接尚不清楚您的问题（有些是彩色的，有些是带下划线的，有些则没有）

我不知道是否可以使用工作表函数来完成，但是这个VBa可以做到。

Option Explicit

Sub CrazyAirlines()

'************** There are things you may need to edit here

Dim currentRow As Integer
currentRow = 1 'I assume we start on row 1, if row 1 is actually headings, change this to the first row of data

Dim destinationRow As Integer
destinationRow = 1 ' assuming there is no heading again, if there is, change to a 2

Dim airlineCol As String
airlineCol = "A"

Dim destinationCol As String
destinationCol = "B"

Dim extraCol As String
extraCol = "C"

Dim origSheet As String
origSheet = "Sheet1" ' the name of of the sheet where the values currently live

Dim destSheet As String
destSheet = "Sheet2" ' this is the sheet name where the results will be

' *********** Hopefully you don't need to edit anything under this line!!

Worksheets(destSheet).Cells.Clear

Do While (Worksheets(origSheet).Range(airlineCol & currentRow).Value <> "")

    Dim airline As String
    airline = Worksheets(origSheet).Range(airlineCol & currentRow).Value

    Dim destinations As String
    destinations = Worksheets(origSheet).Range(destinationCol & currentRow).Value

    Dim extraInfo As String

    Dim title As String

    Dim spInfo() As String
    spInfo = Split(destinations, ":")

    If (UBound(spInfo) > 0) Then
        title = spInfo(0)
    End If

    destinations = Replace(destinations, title & ":", "")

    Dim spDest() As String
    spDest = Split(destinations, ",")

    Dim i As Integer

    For i = 0 To UBound(spDest)

        Worksheets(destSheet).Range(airlineCol & destinationRow).Value = RemoveSquare(Trim(airline))

        Dim des As String
        des = RemoveSquare(spDest(i))

        Dim containsExtra() As String
        containsExtra = Split(spDest(i), "(")

        If UBound(containsExtra) > 0 Then
            title = Replace(containsExtra(1), ")", "")
            des = containsExtra(0)
        End If

        Worksheets(destSheet).Range(destinationCol & destinationRow).Value = Trim(des)

        If (title <> "") Then
            Worksheets(destSheet).Range(extraCol & destinationRow).Value = title
            title = "" 'kill it, kaboom, bang, boom (not good words considering this is about airlines, but hilarious
        End If

        destinationRow = destinationRow + 1

    Next i

    currentRow = currentRow + 1
Loop

End Sub

Function RemoveSquare(s As String)

Dim sp() As String
sp = Split(s, "]")

    If UBound(sp) > 0 Then
        RemoveSquare = sp(1)
    Else
        RemoveSquare = s
    End If

End Function

Sheet1看起来像

在运行上述VBa之后，我的Sheet2看起来像