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

1
Primeiro de tudo, quero começar dizendo que sei que isso é extremamente difícil ou impossível.

Tenho dados (da wikipedia , em qualquer aeroporto da lista de companhias aéreas e destinos), em uma coluna é o nome da companhia aérea e, no outro, uma lista de destinos separados por vírgulas e ocasionalmente alguma informação extra.

O que eu preciso é obter cada destino em uma linha separada, com o nome da companhia aérea ao lado, e a informação extra (Carta, sazonal, "começa ....", referências) em uma terceira coluna.

Eu vou estar fazendo isso repetidamente com várias tabelas da Wikipedia. Estou criando um mapa de rota no Kumu.io. Está tudo bem, qualquer solução não faz tudo, eu só preciso de algo próximo, já que de jeito nenhum eu vou conseguir fazer tudo manualmente. Se você precisar de mais informações, basta me avisar. Obrigado por qualquer ajuda, este é realmente um recurso incrível.

Os dados estão neste formato

Eeuprecisoquepareça

    
por IT IT 15.08.2014 / 02:40

1 resposta

1

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

Eu não tenho ideia se isso pode ser feito com funções de planilha, mas esse 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

EdepoisqueeucorrioVBaacima,minhaPlanilha2parecia

    
por 15.08.2014 / 11:57