Excel Uma célula para muitas fórmulas (sei que isso pode não ser possível)

Excel Uma célula para muitas fórmulas (sei que isso pode não ser possível)

Em primeiro lugar, quero começar por dizer que sei que isto é extremamente difícil ou impossível.

Eu tenho dados (deWikipédia, em qualquer aeroporto da lista de companhias aéreas e destinos), em uma coluna está o nome da companhia aérea e na outra há uma lista de destinos separados por vírgulas e, ocasionalmente, algumas informações extras.

O que preciso é colocar cada destino em uma linha separada, com o nome da companhia aérea ao lado e as informações extras (Charter, sazonal, "começa...", referências) em uma terceira coluna.

Farei isso repetidamente com várias tabelas da Wikipedia. Estou criando um mapa de rotas no Kumu.io. Tudo bem, qualquer solução não faz tudo, só preciso de algo próximo, pois não vou conseguir fazer tudo manualmente. Se precisar de mais informações é só me avisar. Obrigado por qualquer ajuda, este é realmente um recurso incrível.

Os dados estão neste formato

insira a descrição da imagem aqui

E eu preciso que pareça

insira a descrição da imagem aqui

Responder1

Sua pergunta não está clara se você realmente possui hiperlinks ou não (alguns são coloridos, outros sublinhados e outros não)

Não tenho ideia se isso pode ser feito com funções de planilha, mas este VBa faz isso.

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

Folha1 parecia

insira a descrição da imagem aqui

E depois de executar o VBa acima, minha Planilha2 ficou assim

insira a descrição da imagem aqui

informação relacionada