Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
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
Inhaltsverzeichnis

Textteile je nach Farbe in andere Zelle kopieren

Textteile je nach Farbe in andere Zelle kopieren
08.09.2015 21:57:12
CP
Liebe Excel-Spezialisten,
ich bin neu im Forum, blutiger VBA-Anfänger und schlage mich mit vielen Problemen rum.
Konkret geht es diesmal um folgendes:
In der Spalte N befindet sich in vielen Zellen Text mit rot und/oder schwarz.
Ich muß jetzt z.B. den schwarzen Text in die benachbarten Zellen in der Spalte O kopieren.
Für eine einzelne Zelle habe ich das durch viel Probieren und spicken so hinbekommen.
Ich bin aber zu doof, das für die ganze Spalte N hinzubekommen.
Kann mir von Euch jemand helfen ?
Viele Grüße
Christian
Hier das "Listing" (welch großes Wort)
Sub Schwarzen_Text_rauskopieren()
[N1].Select
länge = Len(ActiveCell.Value)
For i = 1 To länge
If ActiveCell.Characters(Start:=i, Length:=1).Font.Color = 0 Then
inhalt = inhalt & ActiveCell.Characters(Start:=i, Length:=1).Text
End If
Next i
[O1].Value = inhalt
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textteile je nach Farbe in andere Zelle kopieren
08.09.2015 22:05:59
Daniel
Hi
wenn du das alleine rausgefunden hast, dann ist das schon mal sehr gut.
wenn du die ganze Spalte N bearbeiten willst, dann mit einer Schleife über alle Zellen von Spalte N, die einen Text enthalten
Sub Schwarzen_Text_rauskopieren()
Dim Zelle as Range
Dim länge as Long
dim i as Long
Dim Inhalt as String
For Each Zelle in Columns(14).SpecialCells(xlcelltypeconstant, 2)
länge = Len(Zelle.Value)
Inhalt = ""
For i = 1 To länge
If Zelle.Characters(Start:=i, Length:=1).Font.Color = 0 Then
inhalt = inhalt & Zelle.Characters(Start:=i, Length:=1).Text
End If
Next i
Zelle.Offset(0, 1).value = Inhalt
Next Zelle
End Sub
Gruß Daniel

Anzeige
AW: Textteile je nach Farbe in andere Zelle kopieren
08.09.2015 22:21:45
Gerd
Hallo C.,
für den Anfang evtl. einfacher nachvollziehbar.
Sub Schwarzen_Text_rauskopieren_3()
'Variablen deklarieren
Dim lngCt As Long
Dim i As Integer
Dim strInhalt As String
For lngCt = 1 To Cells(Rows.Count, 14).End(xlUp).Row 'Zeile letzter gefüllter Zelle Spalte N
strInhalt = "" 'Variable vor neuer Ermittlung leeren
For i = 1 To Len(Cells(lngCt, 14).Value) '...bis Zeichenlänge durchlaufener Zelle
If Cells(lngCt, 14).Characters(Start:=i, Length:=1).Font.Color = 0 Then
strInhalt = strInhalt & Cells(lngCt, 14).Characters(Start:=i, Length:=1).Text
End If
Next i
Cells(lngCt, 15) = strInhalt
Next
End Sub
Gruß Gerd

Anzeige
AW: Textteile je nach Farbe in andere Zelle kopieren
09.09.2015 09:45:51
CP
Hallo Daniel und Gerd,
vielen Dank für Eure Lösung. Hat mich heute in der Arbeit gerettet!
Christian

368 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige