☰

Excel 1 つのセルから複数のセルへの数式 (これは不可能かもしれないと認識しています)

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2013
Excel 1 つのセルから複数のセルへの数式 (これは不可能かもしれないと認識しています)

まず最初に、これは非常に困難、あるいは不可能なことだということを私は承知していると申し上げたいと思います。

私はデータを持っています（ウィキペディア、航空会社と目的地のリストにあるどの空港でも、1 つの列に航空会社名が表示され、もう 1 つの列にはコンマで区切られた目的地のリストと、場合によっては追加情報が表示されます。

必要なのは、各目的地を別々の行に表示し、その横に航空会社名を表示し、3 番目の列に追加情報 (チャーター、季節限定、「開始...」、参照) を表示することです。

私は、複数の Wikipedia テーブルでこれを繰り返し実行します。 Kumu.io でルート マップを作成しています。 あらゆるソリューションですべてを実行できなくても問題ありません。すべてを手作業で行うのは不可能なので、それに近いものが必要です。 さらに情報が必要な場合は、お知らせください。 ご協力いただきありがとうございます。これは本当に素晴らしいリソースです。

データはこの形式です

ここに画像の説明を入力してください

そして私はこう見えるようにする必要がある

ここに画像の説明を入力してください

答え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は次のようになりました

ここに画像の説明を入力してください

関連情報