ALLE Klammern färben, funktioniert, aber...

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm TextBox
Bild

Betrifft: ALLE Klammern färben, funktioniert, aber...
von: da.ricci
Geschrieben am: 11.07.2015 03:14:29

Hallo VBA-ler,
in Anlehnung an einen Beitrag aus Herbers Excel-Forumsarchiv aus dem 2011 Jahr:
Text zwischen eckiger Klammer grün einfärben
habe ich versucht ALLE Klammern() inkl. Inhalt in einer Zelle zu "highlighten".
Was mir auch nach unzähligen "Macro-Einzelschritten" gelang.
CodeAuszug:


 For Each aCell In rngStrecke
    iPos(1) = InStr(1, aCell, "(")
    iLen(1) = InStr(1, aCell, ")") - iPos(1)
    iPos(2) = InStr(iPos(1) + 1, aCell, "(")
    iLen(2) = InStr(iPos(2) + 1, aCell, ")") - iPos(2)
    ....
    ....
    ....
          ' (**) formatieren
    If iPos(1) > 0 And iLen(1) > 0 Then
        aCell.Characters(Start:=iPos(1), Length:=iLen(1) + 1).Font.Color = rgbRed
        aCell.Characters(Start:=iPos(1), Length:=iLen(1) + 1).Font.Bold = True
        aCell.Characters(Start:=iPos(1), Length:=iLen(1) + 1).Font.Size = 12
    End If
    If iPos(2) > iPos(1) And iLen(2) > 0 Then
        aCell.Characters(Start:=iPos(2), Length:=iLen(2) + 1).Font.Color = rgbRed
        aCell.Characters(Start:=iPos(2), Length:=iLen(2) + 1).Font.Bold = True
        aCell.Characters(Start:=iPos(2), Length:=iLen(2) + 1).Font.Size = 12
    End If
    ....
    ....
    ....
 Next aCell

das Ergebnis ist eigentlich zufriedenstellend - ABER:
in der "Testphase" färbte ich die Klammern+Inhalt in "Multifarben":
CodeAuszug:

    If iPos(1) > 0 And iLen(1) > 0 Then
        aCell.Characters(Start:=iPos(1), Length:=iLen(1) + 1).Font.Color = rgbViolet
    End If
    If iPos(2) > iPos(1) And iLen(2) > 0 Then
        aCell.Characters(Start:=iPos(2), Length:=iLen(2) + 1).Font.Color = rgbRed
    End If
    If iPos(3) > iPos(2) And iLen(3) > 0 Then
        aCell.Characters(Start:=iPos(3), Length:=iLen(3) + 1).Font.Color = rgbBlue
    End If
    ....
    ....
    ....
und das Ergebnis war ein willkürliches Farbspektakel.
Irgendwie ist mir die InStr-Funktion noch ein bisschen "spanisch".
(vielleich kann mir wer diese Funktion - mit all den Len und Mid, .. - mit "einfachen" Worten erklären) ;-)
Frage dazu:
1.) woran liegt das willkürliches Farbspektakel?
2.) und wie könnte man den Code kürzen und gleichzeitig auf iPos(1 To x) erweitern ?
anbei meine Musterdatei:
KlammernÄndern.xls
Grüsse
da.ricci

Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: Sepp
Geschrieben am: 11.07.2015 07:26:43
Hallo Richard,
mit Schleife so.

Sub KlammerFarbe()
  Dim lngPos As Long, lngLen As Long, lngI As Long
  Dim aCell As Object, rngStrecke As Range
  
  On Error GoTo ErrExit
  
  Application.ScreenUpdating = False
  
  Set rngStrecke = ActiveSheet.Range("B2:B32")
  
  For Each aCell In rngStrecke
    lngPos = 0
    lngLen = 0
    lngI = 0
    Do
      lngPos = InStr(lngPos + 1, aCell, "(")
      If lngPos > 0 Then
        lngLen = InStr(lngPos, aCell, ")") - lngPos
        If lngLen > 0 Then
          lngI = lngI + 1
          If lngI > 9 Then lngI = 1
          With aCell.Characters(Start:=lngPos, Length:=lngLen + 1).Font
            .Color = Choose(lngI, rgbViolet, rgbRed, rgbBlue, rgbDarkCyan, rgbDarkSeaGreen, _
              rgbGoldenrod, rgbDarkTurquoise, rgbDarkOrange, rgbMediumPurple)
            .Bold = True
            .Size = 12
          End With
        End If
      End If
    Loop While lngPos > 0
  Next
  
  ErrExit:
  Err.Clear
  On Error GoTo 0
  
  Application.ScreenUpdating = True
  Set rngStrecke = Nothing
End Sub


"woran liegt das willkürliches Farbspektakel?"
Na weil verschiedene Farben zugewiesen werden! rgbViolet, rgbRed, ...
Informationen zu Instr(), Mid() findest du in der Hilfe zu VBA, Cursor auf das entsprechende Wort > F1.
Gruß Sepp


Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: da.ricci
Geschrieben am: 11.07.2015 14:15:03
Hallo Sepp,
danke für deine Rückmeldunng und Lösung - feine Sache - und soo "einfach", wenn man weiß wie's geht. ;-)
>> "woran liegt das willkürliches Farbspektakel?"
> "verschiedene Farben zugewiesen werden! rgbViolet, rgbRed, ... "
das war mir doch klar ;-)
siehe: "in der "Testphase" färbte ich die Klammern+Inhalt in "Multifarben" "
gemeint war: willkürliches Farbspektakel
in meinem Beispiel ist rgbViolet, rgbRed, ... nicht immer an Position 1, Position 2, ...
sondern: sehr willkürlich. - Warum? - wo ist der "Gedankenfehler" in meinem Code?
in meiner AM wird im Endeffekt nur Rot benutzt - wie gesagt die "Multifarben" wurden nur für
Testabläufe mit Einzelschritten eingebaut, was die von Dir benutzte "Choose-Funktion" auch
hervorragend löst.
(und vorallem: die "richtigen" Farben an die "richtige" Position)
insgesamt toller Code, danke nochmal
LG da.ricci

Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: Sepp
Geschrieben am: 11.07.2015 23:01:01
Hallo Richard,
in deinem Code wird, je nach Anzahl der Klammern im String, nicht jede Variable (neu) belegt, dadurch sind die Variablen entweder 0, oder noch vom vorherigen Durchlauf belegt. Und das verursacht bei den Anschließenden x > y Prüfungen ein Durcheinander.

Gruß Sepp


Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: da.ricci
Geschrieben am: 12.07.2015 00:05:15
Hallo Sepp,
ja das stimmt wohl - wenn die Anzahl der (*) genau 9 sind war auch die reihenfolge richtig ;-)
ansonsten wurden die (*) wieder von Beginn an gefärbt bis halt die Anzahl wieder 9 war.
hmmm - mal abgesehen, das Dein Code die Bedingung richtig erfüllt, wesentlich kürzer und übersichtlicher ist, leicht zu lesen (schwerer zu verstehen - gilt natürlich nur für mich) ;-), an welcher Stelle hätte ich, in meinem Code, die Schleife - sinnvoll - "abrechen" können?
(wie gesagt - dient nur zum Verstehen - da sowieso nur rot gefärbt wird)
 Schönen Abend
      da.ricci  alias  Richard (oder umgekehrt)

Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: Sepp
Geschrieben am: 12.07.2015 00:08:54
Hallo Richard,
du musst alle Variablen (iLen(x) und iPos(x)) am Beginn der Schleife auf 0 stellen.

Gruß Sepp


Bild

Betrifft: AW: ALLE Klammern färben, funktioniert, aber...
von: da.ricci
Geschrieben am: 12.07.2015 01:22:41
Hallo Sepp,
nochmals danke für deine Lösung - hättest du hierfür auch eine parat?
ich bastle momentan daran, den Zelleninhalt (wie in der BeispielMappe):

Fa (SA) - Garteng., 2201 (UA) - Jura-Soyfer-Gasse, 1100 (FG) - 
Wimpffeng., 2232 (NK) - Guglg., 1030 (AB) - Blumauerg., 1020 (OF) - Fa (SA)
in Spalten aufzuteilen. das gewünschte Ergebnis sollte so aussehen:
Jura-Soyfer-Gasse, 1100
(FG)

Status quo: als eindeutiger Teiler ist immer Zeichenfolge " - " vorhanden und mittels Code:
Dim sText As String, iPos As Integer, iCol As Integer, iIndxRow As Integer
For iIndxRow = 2 To Range("A" & Rows.Count).End(xlUp).Row 
    sText = Range("A" & iIndxRow).Value
    iPos = InStr(sText & " ", "- ")
    iCol = 2 
        While iPos > 0 
            Cells(iIndxRow, iCol).Value = Trim(Left(sText, (iPos - 1))) 
            sText = Right(sText, Len(sText) - iPos - 1)       
            iPos = InStr(sText & " ", "- ") 
            iCol = iCol + 2
        Wend
    Cells(iIndxRow, iCol).Value = sText 
Next iIndxRow
teile ich den Textinhalt auf jede 2te Spalte auf.
Wie müsste man die Schleife erweitern, um den Inhalt der neuen SpaltenInhalte ab Zeichen "(" zu teilen?
meine Überlegung wäre nach

Cells(iIndxRow, iCol).Value = sText
eine neue For-Next-Schleife ala:
For iIndxCol = 2 To Range(iCol & iIndxRow).End(xlToLeft).Column Step 2
einzubauen, nur wie isoliere ich den Teil "(*)" ? (denke da an MID aber da bin ich noch am googlen)
Das eigentliche Ziel ist jedoch, den Zellinhalt in UF.Textboxen(i) einzulesen - und falls bearbeitet oder neu den Textboxen(i)-Inhalt in die Zelle lt. Vorgabe zu übergeben - Aber das sind noch Meilensteine. ;-)
  Schönen Abend - od. Nacht
    LG da.ricci alias Richard

Bild

Betrifft: Zellinhalt aufteilen für Textboxen
von: da.ricci
Geschrieben am: 12.07.2015 05:20:13
Hallo Sepp,
die im letzten Beitrag genannte Aufgabe habe ich soweit gelöst, das ich den Zellinhalt in gewünschte Teile zerlegt habe:

Sub StreckeTrennen()
Dim sText As String, iPos As Integer, iCol As Integer, iIndxRow As Integer 
Dim iIndxCol As Integer, iPos2 As Integer, iLen2 As Integer
For iIndxRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    sText = Cells(iIndxRow, 1).Value
    iPos = InStr(sText & " ", "- ") 
    iCol = 2
    While iPos > 0 
        Cells(iIndxRow, iCol).Value = Trim(Left(sText, (iPos - 1)))
        sText = Right(sText, Len(sText) - iPos - 1) 
        iPos = InStr(sText & " ", "- ")
        iCol = iCol + 2
    Wend
    Cells(iIndxRow, iCol).Value = sText
    For iIndxCol = 2 To Cells(iIndxRow, iCol + 2).End(xlToLeft).Column Step 2
        sText = Cells(iIndxRow, iIndxCol).Value
        iPos2 = InStr(1, sText, "(")
        iLen2 = InStr(1, sText, ")") - iPos2
        Cells(iIndxRow, iIndxCol) = Trim(Application.WorksheetFunction.Substitute _
        (Cells(iIndxRow, iIndxCol), Mid(sText, iPos2, iLen2 + 1), ""))
        Cells(iIndxRow, iIndxCol + 1).Value = Trim(Mid(sText, iPos2, iLen2 + 1))
    Next iIndxCol
Next iIndxRow 
End Sub
wie müßte man den Code optimieren, damit ich Textboxen(1-30) in einer Userform damit füllen kann - ohne Umweg
über "Extra-Spalten im TabellenBlatt"?
  Grüße
    da.ricci alias Richard

Bild

Betrifft: AW: Zellinhalt aufteilen für Textboxen
von: Sepp
Geschrieben am: 12.07.2015 09:24:51
Hallo Richard,
na in dem du den Text eben gleich in die TextBoxen schreibst!

UserForm1.TextBox1 = Trim$(....
Die TextBoxen kann man auch per Schleife ansprechen.
UserForm1.Controls("TextBox" & zähler).Value = Trim$(....
Gruß Sepp


Bild

Betrifft: AW: Zellinhalt aufteilen für Textboxen fast fertig
von: da.ricci
Geschrieben am: 13.07.2015 01:41:25
Hallo Sepp,
vielen Dank für Deine Hilfe - ich hab's soweit hinbekommen - mit:

Private Sub Wegstrecke_auslesen()
Dim sText As String, iPos As Integer, iPos2 As Integer, 
Dim iLen2 As Integer, i As Integer, n As Integer
For i = 1 To 32
    Me.Controls("TextBox" & i).Text = ""
Next i
sText = Range("B" & aktZeile).Value 
iPos = InStr(sText & " ", "- ")
i = 1
While iPos > 0
    UserForm1.Controls("TextBox" & i).Value = Trim(Left(sText, (iPos - 1)))
    sText = Right(sText, Len(sText) - iPos - 1)
    iPos = InStr(sText & " ", "- ")
    i = i + 2
Wend
Me.Controls("TextBox" & i).Value = sText 
For n = 1 To i Step 2
    sText = Me.Controls("TextBox" & n).Value
    iPos2 = InStr(1, sText, "(")
    iLen2 = InStr(1, sText, ")") - iPos2
    If iPos2 > 0 Then 
        Me.Controls("TextBox" & n).Text = Trim$(Application.Substitute _
        (Me.Controls("TextBox" & n).Text, Mid(sText, iPos2, iLen2 + 1), ""))
            ' === Klammern werden nicht in TextBox eingetragen
        Me.Controls("TextBox" & n + 1).Value = Trim(Mid(sText, iPos2 + 1, iLen2 - 1))
    End If
Next n
End Sub
wird der ZellInhalt auf die TextBoxen aufgeteilt - und mit:
Private Sub Wegstrecke_eintragen()
Dim ArrayWerte() As String, i As Integer, iCount As Long
ReDim Preserve ArrayWerte(32) 'Anzahl TextBoxen  32
    For i = 1 To 32 Step 2
        If Me("TextBox" & i) <> "" Then
                                     ' === TextBox1 & (TextBox2) verbinden
            ArrayWerte(iCount) = Me("TextBox" & i) & " (" & Me("TextBox" & i + 1) & ")"
            iCount = iCount + 1
        End If
    Next i  
    If iCount > 0 Then
        ReDim Preserve ArrayWerte(iCount - 1)
        ActiveSheet.Range("D" & aktZeile) = Join(ArrayWerte, " - ")
    End If
End Sub
wieder in die Zelle zurück geschrieben.
Für den "Feinschliff" benötige ich aber Deine Hilfe - da habe ich echt keine Idee.
Da zu 98% der Start von Fa ist, ist hier gleich die Eingabe einer Zielstrecke erlaubt bzw. Vorgabe, mit " - " als Trenner
und zu 98% ist, das letzte Ziel die Fa - hier muss/soll kein (Zweck) mehr eingegeben werden.
Zur besseren Verdeutlichung:
1.) die BerichtsAnsicht: (ZellenInhalt)  
 Fa - Salzgasse, 3342 (KB) - Jura-Soyfer-Gasse, 1100 (FG) - Fa

2.) die EingabeMaske: (TextBoxen)  
Wegstrecke
Zweck
 Fa - Salzgasse, 3342KB
 Jura-Soyfer-Gasse, 1100 FG
 Fa 
so solten die Ergebnsse aussehen, um damit weiterarbeiten zu können. ;-)
Mein Code liefert folgende Ergebnisse: (welche in der Weiterverarbeitung einen Fehler auslöst)
A.) beim einlesen aus der Tabelle:  
Wegstrecke
Zweck
 Fa 
 Salzgasse, 3342KB
 Jura-Soyfer-Gasse, 1100 FG
 Fa 

B.) beim eintragen in die Tabelle:  
 Fa () - Salzgasse, 3342 (KB) - Jura-Soyfer-Gasse, 1100 (FG) - Fa ()

Die letzten 2% sind meist mit "Übernächtigungen" verbunden - hier muss die letzte Position bzw. der Start mit (Zweck) eingegeben werden.
wie gesagt, ich weis hier echt nicht mehr weiter - ich hoffe Du hast hierzu, nochmals, eine Lösung.
gilt natürlich für alle VBA-Profis ;-)
Danke schon mal im Voraus
  Grüße
   da.ricci




Bild

Betrifft: AW: Zellinhalt aufteilen für Textboxen fast fertig
von: da.ricci
Geschrieben am: 14.07.2015 13:10:59
Hallo an Alle,
niemand, der für letzt-genanntes Problem eine Lösung hat?
Grüße
da.ricci alias Richard

Bild

Betrifft: Aufgabe gelöst !
von: da.ricci
Geschrieben am: 16.07.2015 04:38:02
Grüße da.ricci

 Bild

Beiträge aus den Excel-Beispielen zum Thema "ALLE Klammern färben, funktioniert, aber..."