Bestimmtes Element aus mehrdimensionalen Array auslesen
12.07.2020 11:32:33
Hermann
Ich bitte euch um Hilfe mit einem Macro, welches Excelcellen formatieren soll! Die Zellen enthalten HTML formatieren Text der in einen nativen Exceltext umgewandelt werden soll. Da die Tabelle relativ umfangreich ist wurden die Daten in ein Array gestellt! Die Umwandlung des Zeilenumbruchs ([BR]) und der Listenelemente [LI] konnten breits gelöst werden. Nur die Bold Textstellen verursachen Probleme! Wenn ein Text mit Bold formatiert wurde (Charakter.font.bold) und die nächste Textstelle aufgerufen wird, die zu zuvor geänderte Textstelle wieder auf normal gestellt.
Jetzt habe ich mir gedacht ich könnte die Anfangs- und Endposition zusammen mit dem Text in einem mehrdimensionalen Array speicher und erst ganz am Schluß die Textstellen mit Bold formatieren. Leider reichen meine VBA Kenntnisse dazu nicht ganz aus um dieses Macro zu schreiben und das Problem lösen zu können!
Bitte entschuldigt die Formatierung aber ich musste im PGM Code die HTML Tags "verstümmeln" damit der Text lesbar bleibt!!
Hier der Code zu meinem Problem:
Sub HTMLRetour()
Dim TextArr() As Variant
Dim TextArr2() As Variant
Dim BoldArr(0 To 9, 0 To 1) As Integer
Dim AnzZeile As Long
Dim PositionStart As Integer
Dim PositionEnde As Integer
Dim b, e, i, j As Integer
Dim StrLaenge As Integer
'Anzahl Elemente in Exceltabelle für dyn. Array ermitteln
For i = 3 To 50000
If Cells(i, 3).Value = "" Then
Exit For
End If
Next
'3 dim. Array in der größe der Datentabelle erstellen - 3 = letzte leere Zeile + 2 Headerzeilen
'Text + Bold vorkommen (max. 10x)
ReDim TextArr(i - 3, 0 To 9, 0 To 1)
e = i - 1 ' Anzahl Elemente in Exceltabelle
'Array mit Daten befüllen --> mit 0 beginnend
For i = LBound(TextArr) To UBound(TextArr)
TextArr(i, 0, 0) = Cells(i + 3, 3).Value
Next
'Verarbeitung des Array mit Formatierungen
For i = LBound(TextArr) To UBound(TextArr)
PositionStart = 1
' HTML Codes für Sonderzeichen wieder zurücksetzen
TextArr(i, 0, 0) = Replace(TextArr(i, 0, 0), "[LI]", " ")
TextArr(i, 0, 0) = Replace(TextArr(i, 0, 0), "[/u]", "")
' Zeilenumbruch innerhalb der Zelle - nach allen Formatierungen damit keine
' Positionsverschiebungen durch vbCrLF passieren
For j = 1 To 30
PositionStart = InStr(1, TextArr(i, 0, 0), "[BR]", 1)
If PositionStart 0 Then
AnzZeile = AnzZeile + 1
'String mit vblf ( Chr(10) ) und entfernten [BR] Tag
TextArr(i, 0, 0) = Left(TextArr(i, 0, 0), PositionStart - 1) & Chr(10) & Mid(TextArr(i, _
0, 0), PositionStart + 4, 2000)
Else
'Schleife verlassen - [BR] kommt nicht mehr vor
If PositionStart = 0 Then
Exit For
End If
End If
Next
'Arraydaten für Bold Zeichen erstellen (max. 10 Vorkommen)
b = 0
For j = 1 To 10
PositionStart = InStr(1, TextArr(i, 0, 0), "[B]", 1)
If PositionStart 0 Then
PositionEnde = InStr(1, TextArr(i, 0, 0), "[/B]", 1)
End If
If PositionStart 0 And PositionEnde 0 Then
'Endtag zuerst entfernen damit sich Startposition nicht ändert
TextArr(i, 0, 0) = Left(TextArr(i, 0, 0), PositionEnde - 1) & Mid(TextArr(i, 0, 0), _
PositionEnde + 4, 2000)
TextArr(i, 0, 0) = Left(TextArr(i, 0, 0), PositionStart - 1) & Mid(TextArr(i, 0, 0), _
PositionStart + 3, 2000)
TextArr(i, b, 0) = PositionStart
TextArr(i, b, 1) = PositionEnde
b = b + 1
Else
Exit For
End If
Next
Next
' Formatierung BOLD Texte
For i = LBound(TextArr) To UBound(TextArr)
Cells(i + 3, 3).value = textArr(i, 0, 0)
For b = LBound(BoldArr) To UBound(BoldArr)
PositionStart = TextArr(i, b, 0)
PositionEnde = TextArr(i, b, 1)
Cells(i, 3).Characters(PositionStart, PositionEnde - PositionStart - 3).Font.Bold = _
True
Next
Next
End Sub
Ich hoffe, ich konnte ungefähr vermitteln was ich gerne mit dem Macro bewerkstelligen möchte.
Vielleicht gibt es ja auch eine komplett einfache Möglichkeit dies zu bewerkstelligen!
Hier noch ein Mustertext der "Excelkonform" umgewandelt werden sollte! Die Tabelle hat ca. 18.000 Zeilen!
§52/7a Fahrverbot für Lastkraftfahrzeuge mit[BR]Gewichtsangabe 960/2,5mm Typ 3[BR][BR][B]Flache Verkehrszeichen:[/B][BR]Alu-Speziallegierung - Stärke 2 mm, 2,5 mm oder 3 mm.[BR][BR][B]Befestigungsart:[/B][BR]In Rohrrahmen oder mit KC-Laschen auf Rohrsteher.[BR][BR]Die Befestigung von folienbelegten Schildern, insbesondere von Folie Typ 1, 2 und 3 ist grundsätzlich ohne Durchbohren der Folie vorzunehmen![BR][BR][B]RA3-Aufbau C (Folie Typ 3) - Folienaufbau Prismatisch[/B][BR]Microprismentechnik der Bauart RA3 bietet höchste Rückstrahlwerte. Besonders geeignet für den Einsatz von Überkopf- und Seitenbeschilderung.[BR]Haltbarkeit 12 Jahre[BR][BR][B]Allgemein[/B][BR]Alle Verkehrszeichen und -tafeln entsprechen hinsichtlich Größe, Form, Farbe, Symbolen, Beschriftung, Rückstrahlwerten, Materialien und Verarbeitung den jeweiligen geltenden gesetzlichen Bestimmungen der StVO und Straßenverkehrszeichenverordnung sowie den einschlägigen Normen, Vorschriften und Richtlinien in der jeweils geltenden Fassung. Die Ecken sind abgerundet und die Vorderseite ist mit Folie belegt. Die Rückseite ist Alu natur und blendfrei. Die Kennzeichnung erfolgt entsprechend den jeweils gültigen Normen, Vorschriften und Richtlinien.[BR]
Vielen Dank im Voraus
Hermann
Anzeige