Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1780to1784
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
1780to1784
1780to1784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Suchen und Text kürzen

Suchen und Text kürzen
08.09.2020 23:32:53
xtian
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

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen und Text kürzen
09.09.2020 03:22:34
Matthias
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
AW: Suchen und Text kürzen
09.09.2020 08:20:39
xtian
Hallo Matthias,
das Makro funktioniert jetzt. Vielen Dank für deine Hilfe.
Gruß
Christian
AW: Suchen und Text kürzen
09.09.2020 08:50:30
xtian
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
Anzeige
RaZelle.Offset(-1, 2) muss es heißen owT
09.09.2020 09:00:15
Matthias
AW: RaZelle.Offset(-1, 2) muss es heißen owT
09.09.2020 09:08:45
xtian
Hallo Matthias,
es ist wohl noch zu früh am morgen. Klar, nach oben heißt - davor:). Danke.
Gruß
Christian
siehe auch Anmerkung von Gerd ...
09.09.2020 09:29:16
Gerd
Ä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

AW: siehe auch Anmerkung von Gerd ...
09.09.2020 09:41:44
Gerd
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
Anzeige
AW: siehe auch Anmerkung von Gerd ...
09.09.2020 10:33:50
Gerd
Moin
Schön, das Problem kann so aber inhaltlich auf die letzte Bereichszeile verlagert sein.
Gruß Gerd
AW: siehe auch Anmerkung von Gerd ...
09.09.2020 10:50:30
Gerd
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
AW: Suchen und Text kürzen
09.09.2020 09:17:09
GerdL
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
Anzeige
AW: Suchen und Text kürzen
09.09.2020 09:45:24
xtian
Danke Gerd:)
AW: Suchen und Text kürzen
09.09.2020 09:34:12
Daniel
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
Anzeige
AW: Suchen und Text kürzen
09.09.2020 09:45:40
xtian
Danke Daniel:)

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige