Microsoft Excel

Herbers Excel/VBA-Archiv

Suchen und Text kürzen

Betrifft: Suchen und Text kürzen von: xtian
Geschrieben am: 08.09.2020 23:32:53

Hallo zusammen,
stehe bei meinem Makro etwas auf dem Schlauch und komme irgendwie nicht ans Ziel. Vielleicht kann
mir jemand helfen.

Das Makro soll zunächst in der Spalte E den Buchstaben L suchen. Wurde der Buchstabe L gefunden,
soll das Makro den Text 2 Zellen weiter (also Spalte G) auf maximal 20 Zeichen (von links) kürzen.

Sub SuchenKuerzen()
    Dim RaZelle As Range
    Dim LastRow As Long
    Dim intZeile As Long
    LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
        For Each RaZelle In Range("E1:E" & LastRow)
            If RaZelle = "L" Then
            RaZelle.Offset(0, 2)
            Len(.Cells(intZeile, 7).Value) > 20 Then
            .Cells(intZeile, 7).Value = Left(.Cells(intZeile, 7).Value, 20)
        End If
    Next RaZelle
End Sub
Viele Grüße
Christian

Betrifft: AW: Suchen und Text kürzen
von: Matthias L
Geschrieben am: 09.09.2020 03:22:34

Hallo
Dim RaZelle As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
For Each RaZelle In Range("E1:E" & LastRow)
 If RaZelle = "L" Then
  RaZelle.Offset(0, 2) = Left(RaZelle.Offset(0, 2), 20)
 End If
Next RaZelle
Gruß Matthias

Betrifft: AW: Suchen und Text kürzen
von: xtian
Geschrieben am: 09.09.2020 08:20:39

Hallo Matthias,
das Makro funktioniert jetzt. Vielen Dank für deine Hilfe.
Gruß
Christian

Betrifft: AW: Suchen und Text kürzen
von: xtian
Geschrieben am: 09.09.2020 08:50:30

Hallo,
ich habe da doch noch eine weiterführende Frage. Das Makro läuft super und macht
was es soll. Zusätzlich soll das Makro jetzt noch eine Zelle über der auf 20
Zeichen gekürzten Zelle auch den Text auf 20 Zeichen kürzen. Verwende ich jetzt:

Dim RaZelle As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
For Each RaZelle In Range("E1:E" & LastRow)
If RaZelle = "L" Then
RaZelle.Offset(0, 2) = Left(RaZelle.Offset(0, 2), 20)
RaZelle.Offset(1, 2) = Left(RaZelle.Offset(1, 2), 20)
End If
Next RaZelle

Macht das Makro das aber nur bei dem ersten gefundenen Buchstaben L. Es soll
aber so aussehen:

………………………SpalteE……………………………………SpalteG
………………………………………………………………………………Kürzen20
………………………………L……………………………………………Kürzen20

Viele Grüße
Christian

Betrifft: RaZelle.Offset(-1, 2) muss es heißen owT
von: Matthias L
Geschrieben am: 09.09.2020 09:00:15



Betrifft: AW: RaZelle.Offset(-1, 2) muss es heißen owT
von: xtian
Geschrieben am: 09.09.2020 09:08:45

Hallo Matthias,
es ist wohl noch zu früh am morgen. Klar, nach oben heißt - davor:). Danke.

Gruß
Christian

Betrifft: siehe auch Anmerkung von Gerd ...
von: Matthias L
Geschrieben am: 09.09.2020 09:29:16

Änderung:
Dim RaZelle As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 5).End(xlUp).Row
For Each RaZelle In Range("E1:E" & LastRow)
 If RaZelle = "L" Then
  RaZelle.Offset(0, 2) = Left(RaZelle.Offset(0, 2), 20)
 If RaZelle.Row > 1 Then RaZelle.Offset(-1, 2) = Left(RaZelle. _
Offset(-1, 2), 20)
End If
Next RaZelle


Betrifft: AW: siehe auch Anmerkung von Gerd ...
von: Daniel
Geschrieben am: 09.09.2020 09:41:44

oder einfacher so, dann hat man das Problem nicht.
For Each RaZelle In Columns(5).specialcells(xlcelltypeconstants, 2)
  If RaZelle = "L" Or RaZelle.Offset(1, 0) = "L" Then  _
        RaZelle.Offset(0, 2) = Left(RaZelle.Offset(0, 2), 20)
  End If
Next RaZelle
Gruß Daniel

Betrifft: AW: siehe auch Anmerkung von Gerd ...
von: GerdL
Geschrieben am: 09.09.2020 10:33:50

Moin
Schön, das Problem kann so aber inhaltlich auf die letzte Bereichszeile verlagert sein.
Gruß Gerd

Betrifft: AW: siehe auch Anmerkung von Gerd ...
von: Daniel
Geschrieben am: 09.09.2020 10:50:30

aber nur dann, wenn die Tabelle bist zur letzten Zeile (1048576) befüllt ist, was aber sehr unwahrscheinlich ist.
und wenn das vorkommen kann, hat man sowieso noch ganz andere Probleme zu lösen.
Gruß Daniel

Betrifft: AW: Suchen und Text kürzen
von: GerdL
Geschrieben am: 09.09.2020 09:17:09

Moin,

ein L in E1 löst einen Fehler aus. Besser erst ab E2 prüfen.

Sub SuchenKuerzen()

    Dim Zelle As Range
    
    For Each Zelle In Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp))
        With Zelle
            If .Value = "L" Then
            .Offset(0, 2) = Left(.Offset(0, 2), 20)
            .Offset(-1, 2) = Left(.Offset(-1, 2), 20)
            End If
        End With
    Next

End Sub

Gruß Gerd

Betrifft: AW: Suchen und Text kürzen
von: xtian
Geschrieben am: 09.09.2020 09:45:24

Danke Gerd:)

Betrifft: AW: Suchen und Text kürzen
von: Daniel
Geschrieben am: 09.09.2020 09:34:12

HI
ich würde sowas so lösen:
With ActiveSheet.UsedRange
   with .columns(.columns.count + 1)
       .FormulaR1C1 = "=IF(RC5=""L"",Left(RC7,20),RC7)
       .Copy
       .Cells(1, 7).Pastespecial xlpastevalues
       .ClearContents
    end with
end with
bzw mit der Zusatzanforderung, hierbei ändert sich die Formel etwas ab:
With ActiveSheet.UsedRange
   with .columns(.columns.count + 1)
       .FormulaR1C1 = "=IF(OR(RC5=""L"",R[1]C5=""L""),Left(RC7,20),RC7)
       .Copy
       .Cells(1, 7).Pastespecial xlpastevalues
       .ClearContents
    end with
end with
das hat gegenüber der Schleifenlösung mit direkter Zellbearbeitung 2 wesentliche Vorteile:
1. es ist bei großen Datenmengen schneller
2. es lässt sich angenehmer im Einzelstep testen.

Gruß Daniel

Betrifft: AW: Suchen und Text kürzen
von: xtian
Geschrieben am: 09.09.2020 09:45:40

Danke Daniel:)

Beiträge aus dem Excel-Forum zum Thema "Suchen und Text kürzen"