Anzeige
Archiv - Navigation
1324to1328
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

Formate aufheben

Formate aufheben
24.07.2013 20:25:04
donalfonso
Hallo VBA-Profis,
ich wäre dankbar, wenn Ihr mir mit VBA folgende Aufgabenstellung lösen könntet:
Ich bekomme regelmäßig Daten, die ich immer wieder manuell umformatieren muss.
Wie Ihr aus der Beispieldatei (Tabelle "unformatiert") sehen könnt, sind die Einträge in den Spalten "A" bis "E" im Zellverbund zusammengefasst. Dieser Zellverbund soll aufgelöst und die Einträge nach unten ausgefüllt werden, wie das im Tabellenblatt "fertig" dargestellt ist.
In Wirklichkeit um fassen die Daten unterschiedlich viele Zeilen - manchmal 2000 ein anderes Mal über 3000, auch die Anzahl der Spalten in denen das gemacht werden soll, ist unterschiedlich.
Für eine professionelle Lösung wäre ich sehr dankbar.
Gruß donalfonso
https://www.herber.de/bbs/user/86537.xlsx

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

Betreff
Datum
Anwender
Anzeige
AW: Formate aufheben
24.07.2013 21:22:39
Matze
Hallo Donalfonso (realname?),
hab hier was gefunden und etwas umgestellt, der Code arbeitet dann in dem unformatierten Blatt(aktives Blatt) ich muss aber noch die letzte Zeile ermitteln , kann ich dort die Spalte A oder besser die Spalte G nutzen, wo ist immer ein Eintrag sicher der die letzte vorgiebt.
Matze

AW: Formate aufheben
24.07.2013 21:42:55
donalfonso
Hallo Matze,
in jedem Fall ist die letzte Zelle mit Inhalt in Spalte "G"
Danke schon im voraus.
Gruß donalfonso

AW: Formate aufheben
24.07.2013 21:43:17
donalfonso
Hallo Matze,
in jedem Fall ist die letzte Zelle mit Inhalt in Spalte "G"
Danke schon im voraus.
Gruß donalfonso

Anzeige
AW: So geht's schneller
25.07.2013 00:58:12
Frank
Hallo,
dein Makro untersucht und formatiert jede einzelne Zelle. Bei 3000 und mehr Zeilen ist deshalb die Verarbeitung entsprechend langsam.
Das folgende Makro benötigt wesentlich weniger Zeit!
Markiere zunächst die letzte Spalte im Spaltenkopf und starte dann das Makro:

Sub Umformatieren()
Application.ScreenUpdating = False
Range(Selection, Cells(1, 1)).Select
With Selection
.WrapText = False
.MergeCells = False
End With
Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
With ActiveSheet.Cells
.EntireColumn.AutoFit
.EntireRow.AutoFit
End With
With ActiveSheet.UsedRange
.Copy
.PasteSpecial Paste:=xlValues
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub

Mit freundlichem Gruß aus der Rattenfängerstadt Hameln
Frank Arendt-Theilen
---
at-exceltraining.de

Anzeige
Danke Frank,....
25.07.2013 11:31:41
Matze
..wie du bestimmt bemerkt hast, bin ich noch Laie was VBA anbelangt
und meine Versuche besser zu werden, nunja meine alten Hirnzellen arbeiten
dementsprechend.
Verstanden habe ich es nun das ich da wirklich mit Zelle im Bereich sehr langsam bin.
Was ich gern noch gewußt hätte, was passiert hier genau:
Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
mit dem "selektierten" Bereich (und der ist ja im dem Moment sehr groß wird ja bis letzte Zeile genutzt)
mit SpecialCells(einen Range zurüch geben) xlCellTypeBlanks(LeerZellen). Formel =Row-1 Column
Ich sehe nur wenn ich den Code mit F8 abarbeite der er die "leeren" Zellen mit der darüber liegen Zeile
befüllt - mir erschließt sich nicht warum/ wodurch.
Matze

Anzeige
AW: Danke Frank,....
25.07.2013 11:39:25
Rudi
Hallo,
mir erschließt sich nicht warum/ wodurch.
es wird z.B. in die leere Zelle A2 die Formel =A1 geschrieben.
Unterbrich doch einfach den Code nach der Zeile und schau dir die Tabelle an. Dann siehst du es.
Das geht übrigens schief, wenn die erste Zeile leer ist.
Gruß
Rudi

AW: Danke Rudi,...
25.07.2013 12:13:09
Matze
hab noch die 2 fehlenden Zeilen unten eingefügt, danke Rudi.
Sub donalfonso()
Application.ScreenUpdating = False
With Cells(1, 1).CurrentRegion
With .Resize(, .Columns.Count - 2)
.UnMerge
.WrapText = False
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
.Copy
.PasteSpecial xlPasteValues
.Columns.AutoFit
.Rows.AutoFit
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub
Matze

Anzeige
Ooooops Zeile korregiert
25.07.2013 12:15:56
Matze
unteres Application.ScreenUpdating = False
durch Application.ScreenUpdating = True
ersetzen

Application.ScreenUpdating = True
25.07.2013 12:29:13
Rudi
Hallo,
überflüssig. Wird bei Ende des Codes automatisch gesetzt.
btw: korrigiert.
Gruß
Rudi

Wieder was gelernt - Danke Rudi
25.07.2013 12:40:21
Matze
ich muss jetzt weg, kommste ohne mich klar ?
Schönen sonnigen Tag @ All
Matze

kürzerer Code
25.07.2013 11:53:40
Rudi
Hallo,
ohne Select etc.
Sub donalfonso()
Application.ScreenUpdating = False
With Cells(1, 1).CurrentRegion
With .Resize(, .Columns.Count - 2)
.UnMerge
.WrapText = False
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
.Copy
.PasteSpecial xlPasteValues
.Columns.AutoFit
.Rows.AutoFit
End With
End With
End Sub

Gruß
Rudi

Anzeige
AW: kürzerer Code
25.07.2013 15:34:43
donalfonso
Hallo VBA-Profis,
leider komme ich erst jetzt dazu, mich für Eure Mühe zu bedanken.
Mit der letzten Variante von Rudi werde ich in Zukunft arbeiten und mir viel Zeit ersparen.
Nochmals vielen Dank an Euch.
Gruß don Alfonso

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige