har brug for et scpript, som kan løbe rækkerne igennem i et excel ark og fjerne html kode, så det kun er tekst der er tilbage. Den tekst kunne evt. overføres til et andet ark...
html i kollonne A: ---------------------------------------------------------------
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
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
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.