Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.05.2024 23:36:08
IFNA Funktion in WENNNV übertragen
16.05.2024 19:31:55
Zellenfarbe beim.Filtern ändern
16.05.2024 19:29:08
Mit INDIREKT() auf andere Tabellenblätter referenzieren
16.05.2024 19:06:22
Monatssumme / Zahlweise / Kalenderjahr
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1948to1952
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1948to1952
1948to1952
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeichenzahl in Zelle länger als dann darunter Zelle einfügen

Zeichenzahl in Zelle länger als dann darunter Zelle einfügen
26.10.2023 11:37:13
Vanessa
Halli Hallo,

ich benötige mal wieder Hilfe und würde mich sehr über euer Feedback freuen.

Folgendes Thema:

in einer Spalte A befinden sich verschieden Werte mit fester Zeichenlänge.
Allerdings wechselt die Länge der Zeichen aller 2 Zeilen.
Allso die
Zeile 1 = 8 Zeichen
Zeile 2 = 16 Zeichen
Zeile 3 = 8 Zeichen
Zeile 4 = 16

12345678
1234567812345678
abcdefgh
abcdefghabcdefgh
abcdefgh
abcdefghijklmnop

nun kann es passieren das genau dieser Rhytmus nicht eingehalten ist und mal statt 8 Zeichen plötzlich 22 Zeichen sind.
In diesem Fall möchte ich gern eine leere Zelle darunter einfügen und den Wert übernehmen und beide Zellen rot markieren.

Mein VBA ist recht schlecht, sicher geht das irgendwie, aber ich habe auch nichts passendes gefunden.

Vielen Dank für Unterstützung!

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeichenzahl in Zelle länger als dann darunter Zelle einfügen
26.10.2023 12:13:02
bigmayo
Moin Vanessa,

das geht mit VBA tatsächlich sehr gut.

Hier ein Vorschlag. Ersetze "DeinBlattName" durch den tatsächlichen Namen deines Blatts. Das Makro geht die Spalte A durch und überprüft die Zeichenlängen. Wenn ein unerwünschtes Muster erkannt wird, fügt es eine Zeile ein, kopiert den Wert und markiert beide Zellen rot.

Füge das Makro ein indem du in Excel "Alt + F11" drückst um den VBA-Editor zu öffnen. Gehe zu "Einfügen" und wähle "Modul". Füge den obigen Code in das Modul ein. Schließe den VBA-Editor und führe das Makro aus ("Alt + F8" drücken für Makroübersicht). 

Sub ÜberprüfeUndKorrigiereMuster()

    Dim ws As Worksheet

    Dim lastRow As Long

    Dim i As Long

    Dim currentLength As Long

    Dim nextLength As Long



    Set ws = ThisWorkbook.Sheets("DeinBlattName") ' Ändere das auf den Namen deines Blattes



    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row



    For i = 1 To lastRow - 1

        currentLength = Len(ws.Cells(i, 1).Value)

        nextLength = Len(ws.Cells(i + 1, 1).Value)



        If (currentLength = 8 And nextLength = 16) Or (currentLength = 16 And nextLength = 8) Then

            ' Einfügen einer Zeile drunter

            ws.Cells(i + 2, 1).EntireRow.Insert xlShiftDown

            ' Kopieren vom Wert in die leere Zelle

            ws.Cells(i + 2, 1).Value = ws.Cells(i + 1, 1).Value

            ' Markieren beider Zellen in rot

            ws.Cells(i + 1, 1).Interior.Color = RGB(255, 0, 0)

            ws.Cells(i + 2, 1).Interior.Color = RGB(255, 0, 0)

        End If

    Next i

End Sub


Gruß
Anzeige
AW: Zeichenzahl in Zelle länger als dann darunter Zelle einfügen
26.10.2023 13:52:51
daniel
Hi
Das geht auch ohne VBA:

1. Schreibe in die Spalte B neben deine Daten die Formel =Zeile()
2. Schreibe in die Spalte C neben die Daten die Formel =Wenn(Länge(A1)=22;Zeile();"")
3. Kopiere Spalte B und C und füge an gleicher Stelle als Wert ein.
4. Kopiere die Spalte C unter die Spalte B
5. Sortiere die ganze Liste nach der Spalte B

Damit solltest du die Leerzeilen eingefügt haben.

Färbung geht dann so
Markiere den Bereich ab A2 und richte eine Bedingte Formatierung ein mit der Formel:
=Oder(Länge(A1)=22;Länge(A2)=22)

Per VBA so: 
Dim z as long 

For z = cells(1, 1).end(xldown).row to 1step -1

    If Len(Cells(z, 1)) = 22 then 

        Cells(z + 1, 1).insert shift:=xldown

        Cells(z, 1).resize(2, 1).interior.color = vbred

    End if 

Next


Gruß Daniel
Anzeige
funktioniert so nicht
26.10.2023 14:34:24
Vanessa
Hallo Daniel,

habe es gleich mal probiert, aber die danebenstehenden Spalten sind belegt
und ich wollte ja automatisch Zeilen einfügen lassen wenn ungleich dem Interval 8/16/8/16.. Zeichen sind

Ich will quasi in einer recht langen Liste erkennen wo der Interval gestört ist
und benötige nach einer "Störung" eine zusätzlich Zelle darunter mit noch einmal
dem fehlerhaften Wert. Also wie folgt: (dabei soll fett die Rote Markierung darstellen)

12345678
1234567812345678
abcdefgh
abcdefghabcdefgh
abcdefgh
abcdefghijklmnop
abcdefgh
abcdefghijklmnop(zu-lang)
abcdefgh
ab(zu kurz)
abcdefgh
abcdefghijklmnop
abcdefgh(zu lang)
abcdefghijklmnop
12345678
1234567812345678
abcdefgh
abcdefghabcdefgh

Ergebnis:

12345678
1234567812345678
abcdefgh
abcdefghabcdefgh
abcdefgh
abcdefghijklmnop
abcdefgh
abcdefghijklmnop(zu-lang)
abcdefghijklmnop(zu-lang)
abcdefgh
ab(zu kurz)
ab(zu kurz)
abcdefgh
abcdefghijklmnop
abcdefgh(zu lang)
abcdefgh(zu lang)
abcdefghijklmnop
12345678
1234567812345678
abcdefgh
abcdefghabcdefgh
Anzeige
AW: funktioniert so nicht
26.10.2023 15:17:18
daniel
habe es gleich mal probiert, aber die danebenstehenden Spalten sind belegt
das hastest du nicht erwähnt, aber es sollte für eine durchschnittlich intelligente Person kein Problem sein, das ganze procedere von Spalte B und C nach M und N, X und Y oder ein anderes Spaltenpaar zu transferieren.

und ich wollte ja automatisch Zeilen einfügen lassen wenn ungleich dem Interval 8/16/8/16.. Zeichen sind
nein, du wolltest eine Leerzeile einfügen lassen, wenn es 22 Zeichen sind.

daher macht mein Marko genau das, was du geschrieben hast. Ich kann nicht wissen, was du willst, ich kann nur lesen, was du schreibst.

und zukünftig ist es immer hilfreich, wenn du schon in der erst anfrage eine Beispieldatei mit hochlädst, in der du zeigst wie die Ausgangsdaten vorliegen und wie du dir das Ergebnis für diese Beispiele vorstellst.
Dann kann man auch seine Makros und Lösungen testen.

Gruß Daniel



Anzeige
AW: funktioniert so nicht
26.10.2023 16:45:11
daniel
HI
vielleicht nochmal eine Formel, die du verwenden kannst, um in einer Hilfsspalte die "Störungen" zu finden.
das funktioniert erst ab Zeile 2, weil die darüberliegende Zeile geprüft wird:
WAHR kennzeichnet einen Fehler, damit kannst du die Formel auch in der Bedingten Formatierung einsetzen:

=Wenn(Länge(A2)=8;Länge(A1)>8;Wenn(Länge(A2)=16;Länge(A2)>8;WAHR))

Gruß Daniel
AW: funktioniert so nicht
27.10.2023 01:12:10
Piet
Hallo Vanessa

bei Fehlersuche schreibe ich mir fehlerhafte Werte lieber in eine separate Tabelle.
Dann muss man weniger scrollen und hat eine bessere Übersicht. Ist nur ein Vorschlag von mir.
Funktioniert denn inzwischen eine Makrolösung der Kollegen, oder bastelt ihr noch daran??

mfg Piet
Anzeige
AW: funktioniert so nicht
27.10.2023 07:42:21
Vanessa
Guten Morgen!

besten Dank für Eure Unterstützung, aber leider bin ich nicht erfolgreich
und würde die Makrovariante bevorzugen. Der Tip die fehlerhaften in eine
separate Tabelle zu legen hatte ich auch schon als Gedanke, würde diese aber verwerfen.
Das erste Makro von bigmayo macht schon das, nur eben genau entgegengesetzt,
mit allen Zellen die es nicht betrifft. Vielleicht können wir an diesem Makro noch einmal festhalten.
Vielen, vielen Dank!

VG
Vanessa
Funktioniert, aber genau gegenteilig
26.10.2023 12:46:59
Vanessa
Hallo bigmayo,

und besten Dank!
Funktioniert, aber genau gegenteilig :)
statt = habe ich schon > versucht, aber klappt nicht.

VG
Vanessa
Anzeige
AW: Zeichenzahl in Zelle länger als dann darunter Zelle einfügen
27.10.2023 20:15:46
Piet
Hallo Vanessa

sitzt du gut auf deinem Stuhl, fällst du mir gleich vor Freude bitte NICHT in Ohnmacht???
Du hast die Lösung doch -selbst erkannt-, nur kein Wissen wie man das in VBA umsetzt!
Schreibe hinter die Codezeile einfach nur den Befehl Else. - Das ist alles! Alles andere bleibt!

If (currentLength = 8 And nextLength = 16) Or (currentLength = 16 And nextLength = 8) Then
Else

Und, funktioniert jetzt dein Makro wie gewünscht?? Würde mich freuen.
Waren 2ß-30 Sekunden Arbeit mit den Code genau anschauen..

Grüsse an den KKollegen für seine Arbeit.

mfg Piet
Anzeige
AW: Funktioniert, aber genau gegenteilig
26.10.2023 13:24:32
bigmayo
Moin Vanessa,

stimmt. Mein Fehler.

Teste es mal so: 

Sub ÜberprüfeUndKorrigiereMuster()

    Dim ws As Worksheet

    Dim lastRow As Long

    Dim i As Long

    Dim currentLength As Long

    Dim nextLength As Long



    Set ws = ThisWorkbook.Sheets("DeinBlattName")



    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row



    For i = 1 To lastRow - 1

        currentLength = Len(ws.Cells(i, 1).Value)

        nextLength = Len(ws.Cells(i + 1, 1).Value)



        If (currentLength > 8 And nextLength > 16) Or (currentLength > 16 And nextLength > 8) Then

            ws.Cells(i + 2, 1).EntireRow.Insert xlShiftDown

            ws.Cells(i + 2, 1).Value = ws.Cells(i + 1, 1).Value

            ws.Cells(i + 1, 1).Interior.Color = RGB(255, 0, 0)

            ws.Cells(i + 2, 1).Interior.Color = RGB(255, 0, 0)

        End If

    Next i

End Sub


Gruß
Anzeige
AW: Funktioniert, aber genau gegenteilig
26.10.2023 13:59:03
Vanessa
Hallo bigmayo,

vielen Dank, aber leider fängt er jetzt ab der 2. Zeile an alles rot zu markieren und entsprechend zu kopieren.

kannst du Bitte noch einmal schauen?

Vielen Dank Dir!

LG Vanessa
AW: Funktioniert, aber genau gegenteilig
26.10.2023 14:24:19
GerdL
Moin Vanessa! 

Sub Unit()



    Const lngErsteZeile As Long = 1

    

    Dim lngCheck As Long

    Dim lngLetzte As Long

    Dim Z As Long

    

    

    lngLetzte = Cells(Rows.Count, "A").End(xlUp).Row

    lngCheck = 8

    

    For Z = lngErsteZeile To lngLetzte

        If Len(Cells(Z, 1)) > lngCheck Then Cells(Z, 1).Font.Color = vbRed

        lngCheck = IIf(lngCheck = 8, 16, 8)

    Next

    

    For Z = lngLetzte To lngErsteZeile Step -1

         With Cells(Z, 1)

            If .Interior.Color = vbRed Then

            Rows(Z + 1).Insert

            .Offset(1).intior.Color = vbren

            .Offset(1) = .Value

            End If

        End With

    Next



End Sub


Gruß Gerd
Anzeige
Objekt nicht unterstützt :(
26.10.2023 14:38:37
Vanessa
Hallo Gerd,

wie schade aber bei mir kommt folgender Fehler:

Objekt unterstützt diese Eigenschaft oder Methode nicht

VG Vanessa
AW: Objekt nicht unterstützt :(
26.10.2023 15:29:53
GerdL
Hallo Vanessa,

mit Korrektur. In welcher Zeile der Beginn ist, musst du ggf. anpassen. 

Sub Unit2()



    Const lngErsteZeile As Long = 1

    

    Dim lngCheck As Long

    Dim lngLetzte As Long

    Dim Z As Long

    

    

    lngLetzte = Cells(Rows.Count, "A").End(xlUp).Row

    lngCheck = 8

    

    For Z = lngErsteZeile To lngLetzte

        If Len(Cells(Z, 1)) > lngCheck Then Cells(Z, 1).Font.Color = vbRed

        lngCheck = IIf(lngCheck = 8, 16, 8)

    Next

    

    For Z = lngLetzte To lngErsteZeile Step -1

         With Cells(Z, 1)

            If .Interior.Color = vbRed Then

            Rows(Z + 1).Insert

            .Offset(1).Interior.Color = vbRed

            .Offset(1) = .Value

            End If

        End With

    Next



End Sub


Gruß Gerd

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige