Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.06.2024 22:07:02
25.06.2024 21:01:55
25.06.2024 19:21:44
Anzeige
Archiv - Navigation
1528to1532
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

Kopieren von Texte mit Bestimmter Formatierung

Kopieren von Texte mit Bestimmter Formatierung
15.12.2016 08:13:34
Texte
Servus,
ich versuche gerade eine große Tabelle übersichtlicher zu machen und bräuchte da von euch mal Hilfe für ein Makro.
In Tabelle1 habe ich mehrere Tabellen in denen sich Einträge enthalten die je nach ihrer Verwendung unterschiedlich gefärbt und Schriftarten haben.
Nun möchte ich das die Texte mit der Schridtart "Arial", Farbe "rot" (laut Makro aufzeichnung "-16776961") haben in Tabelle4 in Spalte A untereinander kopiert werden.
Zu erwähnen wäre noch das in einer Zelle sich Texte mit der Formatierung und auch einer anderen befinden Können.
Es sollen aber nur die Texte in Zelle mit der Formatierung kopiert werden.
Hoffe Ihr könnt mir wieder einmal weiter helfen.
mfg Blue Bird

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: strg-T und FindFormat
15.12.2016 13:22:31
Fennek
Hallo,
die Farbe, auch für Teile einer Zelle, können mit dem Autofilter "nach Farbe" selektiert werden.
Dieser Code sucht nach einem Font:

Sub T1()
Dim rng As Range
Application.FindFormat.Font.Name = "Arial"
With ActiveSheet.UsedRange
Set rng = .Find("*", searchFormat:=True)
If Not rng Is Nothing Then
Anf = rng.Address
Do
Debug.Print rng.Address
Set rng = .FindNext(rng)
Loop Until rng.Address = Anf
End If
End With
End Sub
mfg
Kopieren von Texte mit Bestimmter Formatierung
15.12.2016 13:39:08
Texte
Servus Fennek,
danke erstmal für deine Hilfe, wenn ich das jetzt richtig gemacht habe.
Dann müsste ich ja meine Tabelle1 immer in eine andere Tabelle kopieren damit ich deine Lösung ausführen könnte.
Weil die Ursprungstabelle unberührt bleiben muss.
Diesen Schritt würde ich mir allerdings gerne sparen da es um wirklich große Datenmengen geht.
Deswegen wäre mir eine Lösung wo nur ein Makro die Daten kopiert lieber.
mfg Blue Bird
Anzeige
AW: Kopieren von Texte mit Bestimmter Formatierung
15.12.2016 13:55:05
Texte
Hi,
wenn eine (auch große) Tabelle mit Autofilter gefilter wurde, genügt im Makro ein
.copy sheets(2).cells(1,1)
bzw eine andere Zieladresse, um alle gefilterten Zeilen zu kopieren.
Bei der Suche nach dem Font wird ein Range-Objekt zurückgegen, das z.B. mit
Rows(rng.row).entirerow.copy sheets(2).cells(lr, "A")
kopiert werden kann. (nachdem in lr mit der "last row" ermittelt wurde)
Ich habe keine Absicht einen copy/paste Code zu entwickeln, dauert zu lange und ist nicht mein Interesse.
mfg
AW: Kopieren von Texte mit Bestimmter Formatierung
15.12.2016 14:18:29
Texte
Servus Fennek,
schade das du so ein Makro nicht bauen magst.
Denn genau so ein copy/paste bräuchte ich.
Vlt. findet dich ja jemand anderes der dazu Lust und Laune hat.
Würde mich zumindest sehr darüber freuen, ansonsten habe ich halt Pech gehabt und muss anderweitig schauen.
mfg Blue Bird
Anzeige
evt. Makro zur Hilfe
17.12.2016 10:51:50
Blue
Servus,
ich habe mich natürlich auch selber weiter umgeschaut.
Und habe folgendes Makro gefunden was "fette" Texte in eine andere Spalte verschiebt.
Könnte mir vorstellen das man dieses Makro auf meine Problem umbauen könnte.
Kann es nur leider selber nicht, würde mich echt riesig freuen wenn sich jemand findet der damit was anfangen kann oder selber einen Idee hat wie ein dementsprechendes Makro aussehen könnte.
Sub tt()
Dim rngC As Range, i As Integer
For Each rngC In Range("A1").SpecialCells(xlCellTypeConstants)
For i = 1 To Len(rngC)
If rngC.Characters(i, 1).Font.Bold = False Then
rngC.Offset(0, 1) = Mid(rngC, i, 999)
rngC = Replace(rngC, rngC.Offset(0, 1), "")
Exit For
End If
Next i
Next rngC
End Sub

mfg Blue Bird
Anzeige
AW: evt. Makro zur Hilfe
18.12.2016 12:46:22
Hajo_Zi
in Deinem Beitrag Stand nicht was Dein Problem ist. Das sollte man schon bei einem offenen Beitrag.
Ich hätte vermutet das Makro überträgt was nicht Fett ist, da
If rngC.Characters(i, 1).Font.Bold = False Then

AW: evt. Makro zur Hilfe
19.12.2016 07:14:25
Blue
Servus Hajo_Zi,
mein Problem habe ich nicht noch einmal beschrieben da ich dies in meinem Eröffnungsbeitrag bereits gemacht hatte.
Hätte ich allerdings nochmal erwähnen können das es bereits dort steht.
Zu dem Makro, hast du natürlich recht, es verschiebt die "nicht fetten" Texte.
mfg Blue Bird
AW: evt. Makro zur Hilfe
20.12.2016 10:18:07
Michael
Hallo!
Da Du kein Bsp eingestellt hast, und ich bei manchen Deiner Angaben noch nicht sicher bin, hier mal ein Bsp für Dich: https://www.herber.de/bbs/user/110117.xlsm
Der Code
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") 'Quell-Blatt
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle4") 'Ziel-Blatt
Dim Texte As Range, C As Range, T As String, i As Long
With WsQ
'Quell-Blatt A1:Ax (x = letzte befüllte Zelle in A:A) durchgehen
Set Texte = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For Each C In Texte
For i = 1 To Len(C)
With C.Characters(i, 1).Font
If .Name = "Arial" And .Color = vbRed Then
T = T & C.Characters(i, 1).Text
End If
End With
Next i 'nächstes Zeichen
With WsZ
'in nächste freie Zelle in A:A des Ziel-Blattes übertragen
If Len(T) > 0 Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = T
End If
End With
T = vbNullString
Next C 'nächste Zelle
End With
End Sub
Hast Du es Dir so vorgestellt?
LG
Michael
Anzeige
Fast Perfekt
20.12.2016 13:06:00
Blue
Servus Michael,
erst einmal sehr vielen danke, zum größten Teil ist das so wie ich es brauch.
Hätte nur noch ein paar Änderungswünsche:
1. der Bereich in Tabelle1 in gesucht werden soll, soll die ganze Tabelle1 sein
2. wie kann ich die Zeilen die in Tabelle4 zwischen den Einträgen eingefügt wird entfernen
3. da ich das Makro auch in anderen Dateien verwenden werde und ich dort von mir leider nicht festzulegen andere Farben verwendet werden man den die Farbbezeichnung im Makro über die mit Hilfe des Makrorekorder ausgegebenen Farbbezeichnung (z.B. für Rot = -16776961) verwenden kann.
4. wenn ich das Makro mehrfach verwende schreibt es die Einträge unter die beim letzten mal gefunden Einträge, könnte man es so ändern das es nur die momentan gefundenen Einträge anzeigt. Quasi die Spalte A von Tabelle4 beim ausführen erst einmal leert.
Wenn das noch machbar wäre, wäre ich super glücklich.
mfg Blue Bird
Anzeige
AW: Fast Perfekt
20.12.2016 14:16:35
Michael
Hallo!
Hier meine adaptierte Bsp-Datei: https://www.herber.de/bbs/user/110124.xlsm
Der Code
Sub b()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") 'Quell-Blatt
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle4") 'Ziel-Blatt
Dim Texte As Range, C As Range, a, t As String
Dim i As Long, j As Long, k As Long
WsZ.Columns(1).Clear 'Zellen in Spalte 1 im Ziel-Blatt löschen
With WsQ
'Quell-Blatt "verwendeten Bereich" durchgehen
Set Texte = .UsedRange
ReDim a(0 To Texte.Cells.Count - 1)
For Each C In Texte
For i = 1 To Len(C)
With C.Characters(i, 1).Font
If .Name = "Arial" And .Color = RGB(255, 0, 0) Then
t = t & C.Characters(i, 1).Text
End If
End With
Next i
If Len(t) > 0 Then
a(j) = t: j = j + 1: t = vbNullString: k = k + 1
End If
Next C
ReDim Preserve a(LBound(a) To k - 1)
WsZ.Range("A1").Resize(k, 1) = Application.Transpose(a)
End With
End Sub
Ich habe den Code insgesamt jetzt nochmal geändert, und arbeite mit einem Array, das dann die Ziel-Tabelle direkt füllt; ist vermutlich effizienter, wenn Du wirklich viele Zellen abklapperst.
Anmerkungen zu Deinen Punkten und dem Code:
1. "Die ganze Tabelle1" sind Millionen von Zellen; das wird die Performance vermutlich in die Knie zwingen. Ich hab's Dir jetzt aber mal soweit ergänzt, dass der "verwendete Bereich" des Blattes abgesucht wird. Schau's Dir in der ergänzten Bsp-Datei mal an...
2. Diesen Punkt kann ich nicht nachvollziehen, tut mir leid (v.a. nicht auf Basis MEINER Bsp-Datei).
3. Ja, Du kannst hier natürlich andere Farbwerte setzen - ich würde das dann aber über die RGB-Codes machen (für Rot bspw. RGB(255,0,0)). Du kannst Dir ja von den verwendeten Schriftfarben die RGB-Codes in der Farbpalette (weitere Farben) ansehen...
4. Spalte 1 des Ziel-Blattes wird am Anfang der Routine gelöscht.
Als letzte Anmerkung: Mein aktueller Code wird bei mehr Elementen als etwas über 65000 (abgearbeitete Zellen), sowie mehr als 255 übertragenen Zeichen je Zelle scheitern; da bräuchte es dann eine andere Herangehensweise. Nur mal so als Heads up.
LG
Michael
Anzeige
Tausend Dank!!!
20.12.2016 15:14:20
Blue
Servus Michael,
ich danke dir tausendfach, mit der Änderung komm ich prima zurecht.
Und mit den von dir angegebenen Einschränkungen kann ich leben.
In diesem Sinne ein frohes Fest und nen guten Rutsch!!!
mfg Blue Bird
Aber gerne, lg und frohes Fest! owT
20.12.2016 15:23:28
Michael

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige