Fjern html kode omkring tekst i excel regneark

Er det </h4> der indikerer ny række?

Koden under Ark1 - indsætter redigerede rækker i kolonne B

Dim antalRæk As Long, ræk As Long, indT As String, outT As String
Dim p1 As Integer, p2 As Integer, redRæk As Long, nyRæk As Boolean
Sub fjernHTML()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    redRæk = 1
    Range("B:B").Delete
   
    For ræk = 1 To antalRæk
        indT = Cells(ræk, 1)
        If Right(indT, 1) = ">" Then
            nyRæk = True
        Else
            nyRæk = False
        End If
       
        outT = skanTekst(indT)
        If outT <> "" Then
            Cells(redRæk, 2) = Cells(redRæk, 2) & outT
            If nyRæk = True Then
                redRæk = redRæk + 1
            End If
        End If
    Next ræk
   
    Columns.AutoFit
End Sub
Private Function skanTekst(indTekst)
Dim f As Integer, udTekst As String
Dim tegn As String
    udTekst = ""
   
    For f = 1 To Len(indTekst)
        tegn = Mid(indTekst, f, 1)
        If tegn = "<" Then
            p1 = f
            p2 = 0
        Else
            If tegn = ">" Then
                p2 = f
                p1 = 0
            Else
                If p1 = 0 Then
                    udTekst = udTekst + tegn
                End If
            End If
        End If
    Next f
    skanTekst = udTekst
End Function

Hej supertekst

Tak for det. Det kører bare. Der er bare én ting.

Der er 8 stk. white spaces foran alle rækker.

Kunne implementere at VBA scriptet deleter white space for-og-bag teksten?

På forhånd tak.

Det skulle nok kunne lade sig gøre.

Vender lige tilbage....

Det er bare super! Takker...

Hvis dette ikke ændre resultatet - så har jeg brug for lidt mere info - men lad os nu se..

Rem Version 2
Rem =========
Dim antalRæk As Long, ræk As Long, indT As String, outT As String
Dim p1 As Integer, p2 As Integer, redRæk As Long, nyRæk As Boolean
Sub fjernHTML()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    redRæk = 1
    Range("B:B").Delete
   
    For ræk = 1 To antalRæk
        indT = Cells(ræk, 1)
        If Right(indT, 1) = ">" Then
            nyRæk = True
        Else
            nyRæk = False
        End If
       
        outT = skanTekst(indT)
        If outT <> "" Then
            Cells(redRæk, 2) = Cells(redRæk, 2) & outT
            If nyRæk = True Then
                redRæk = redRæk + 1
            End If
        End If
    Next ræk
   
    Columns.AutoFit
End Sub
Private Function skanTekst(indTekst)
Dim f As Integer, udTekst As String
Dim tegn As String
    udTekst = ""
   
    For f = 1 To Len(indTekst)
        tegn = Mid(indTekst, f, 1)
        If tegn = "<" Then
            p1 = f
            p2 = 0
        Else
            If tegn = ">" Then
                p2 = f
                p1 = 0
            Else
                If p1 = 0 Then
                    udTekst = udTekst + tegn
                End If
            End If
        End If
    Next f
    skanTekst = Trim(udTekst)
End Function

det kører bare!

smider du et svar supertekst?

Og undskylder den lange svar tid... :-/

Ok - der er nu smidt et svarsom #2 - men ellers kan du få et frisk..

????????????????????????????