Votre question n'indique pas clairement si vous avez réellement des liens hypertextes ou non (certains sont colorés, d'autres sont soulignés et d'autres non).
Je ne sais pas si cela peut être fait avec des fonctions de feuille de calcul, mais cette VBa le fait.
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
La feuille 1 ressemblait à
![enter image description here]()
Et après avoir exécuté la VBa ci-dessus, ma feuille 2 ressemblait à ceci
![enter image description here]()
