Excel: Eine Zelle zu viele Formel (mir ist klar, dass das möglicherweise nicht möglich ist)

Question

Zunächst möchte ich sagen, dass ich weiß, dass dies entweder extrem schwierig oder unmöglich ist.

Ich habe Daten (vonWikipedia, auf jedem Flughafen in der Liste der Fluggesellschaften und Ziele), in einer Spalte steht der Name der Fluggesellschaft und in der anderen eine durch Kommas getrennte Liste der Ziele sowie gelegentlich einige Zusatzinformationen.

Ich möchte jedes Ziel in einer separaten Zeile haben, mit dem Namen der Fluggesellschaft daneben und den zusätzlichen Informationen (Charter, saisonal, „beginnt …“, Referenzen) in einer dritten Spalte.

Ich werde dies wiederholt mit mehreren Wikipedia-Tabellen tun. Ich erstelle eine Routenkarte auf Kumu.io. Es ist ok, wenn eine Lösung nicht alles kann, ich brauche nur etwas Ähnliches, da ich es unmöglich alles von Hand machen kann. Wenn Sie weitere Informationen benötigen, lassen Sie es mich einfach wissen. Vielen Dank für jede Hilfe, dies ist wirklich eine großartige Ressource.

Die Daten liegen in diesem Format vor

Und es muss so aussehen wie

Answer 1

Aus Ihrer Frage geht nicht klar hervor, ob Sie tatsächlich Hyperlinks haben oder nicht (einige sind farbig, einige unterstrichen und einige nicht).

Ich habe keine Ahnung, ob dies mit Arbeitsblattfunktionen möglich ist, aber dieses VBa erledigt es.

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 sah aus wie

Und nachdem ich das obige VBa ausgeführt habe, sah mein Sheet2 so aus