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

Question

首先我想说我知道这要么极其困难，要么不可能。

我有数据（来自维基百科，在航空公司和目的地列表中的任意机场），一列是航空公司名称，另一列是用逗号分隔的目的地列表，有时还会包含一些额外信息。

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

我将使用多个 Wikipedia 表重复执行此操作。我正在 Kumu.io 上创建路线图。任何解决方案都不能完全解决所有问题，这没关系，我只是需要一些接近的解决方案，因为我无法手动完成所有操作。如果您需要更多信息，请告诉我。感谢您的任何帮助，这确实是一个很棒的资源。

数据采用这种格式

我需要它看起来像

Answer 1

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

我不知道这是否可以用工作表函数来完成，但这个 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 看起来像