Excel Одна ячейка ко многим (я понимаю, что это не возможно)

Question

Прежде всего, я хочу начать с того, что знаю, что это либо чрезвычайно сложно, либо невозможно.

У меня есть данные (из Википедии, о любом аэропорту в списке авиакомпаний и пунктов назначения), в одном столбце указано название авиакомпании, а в другом - список пунктов назначения, разделенных запятыми, а иногда и некоторая дополнительная информация.

Мне нужно, чтобы каждый пункт назначения был выделен в отдельную строку с названием авиакомпании рядом с ним и дополнительной информацией (чартер, сезон, «начинается ....», ссылки) в третьем столбце.

Я буду делать это неоднократно с несколькими таблицами Википедии. Я создаю карту маршрута на 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

Лист1 выглядел как

И после того, как я запустил выше VBa, мой Sheet2 выглядел как