Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1168to1172
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
1168to1172
1168to1172
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Codeergänzung für Formatänderung

Codeergänzung für Formatänderung
WalterK
Hallo,
den nachfolgenden Code habe ich mit dem Makrorekorder und über die Recherche zusammengebaut. Damit formatiere ich importierte Daten nach meinen Vorstellungen. Funktioniert soweit auch.
Vorläufig wird alles in der Tabelle formatiert als: Selection.NumberFormat = "#,##0.00 _€;[Red]-#,##0.00 _€;" (siehe dazu im unteren Teil des Codes)
Hier bräuchte ich noch folgende Änderung bzw. Auswahlmöglichkeit, wobei die Überschrift jeder Spalte in Zeile 2 steht:
--> wenn die Überschrift "Datum" oder "Beginn" oder "Ende" lautet soll diese Spalte ab Zeile 3 bis zum letzten Eintrag als Datum im Format TT.MM.JJJJ formatiert werden
--> wenn die Überschrift "Mitglied" oder "Sonstiges" lautet soll ab Zeile 3 bis zum letzten Eintrag als Standard formatiert werden
Kann mir das jemand in meinen Code einbauen?
Hier noch mein Code:
Option Explicit 
Sub Tabelleeinrichten()
Dim lngA As Long
Application.ScreenUpdating = False
Columns("A:AZ").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Selection.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWindow.Zoom = 85
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows(1).Insert
lngA = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:AZ2").AutoFilter
With Range("A1")
.FormulaLocal = _
"=WENN(ODER(A2="""";A2=""Datum"";A2=""Geburtsdatum"";A2=""Beginn"";A2=""Ende"";A2="" _
Eintritt"");"""";" & _
"WENN(ISTZAHL(A3);TEILERGEBNIS(9;A3:A" & lngA & ");""""))"
.NumberFormat = "#,##0.00"
.AutoFill Destination:=Range("A1:AZ1"), Type:=xlFillDefault
End With
Range("A1:AZ1").Select
Columns("A:AZ").EntireColumn.AutoFit
Cells.Select
Selection.NumberFormat = "#,##0.00 _€;[Red]-#,##0.00 _€;"
Range("A1").Select
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Besten Dank für Eure Mühe,
Servus, Walter
AW: Codeergänzung für Formatänderung
26.07.2010 09:27:20
Yusuf
Moin,
ungetestet.
Sub formatieren()
For i = 1 To 256
Select Case Cells(1, i)
Case "Beginn"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Datum"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Ende"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Mitglied"
Columns(i).NumberFormat = "general"
Case "Sonstiges"
Columns(i).NumberFormat = "general"
End Select
Next
End Sub
Falls die obige Formatierung deine urspruengliche Formatierung ersetzen soll dann lösche "Selection.NumberFormat = "#,##0.00 _€;[Red]-#,##0.00 _€;"" und fuege anstatt dessen den obigen Code ein, ansonsten kannst du es einfach hinter deine Formatierung kopieren.
Gruß
Yusuf
Anzeige
AW: Codeergänzung für Formatänderung
26.07.2010 11:41:02
WalterK
Hallo Yusuf,
ich habe jetzt den Code bei meinen Code vor dem "End Sub" eingefügt.
Allerdings kommt die Meldung: Fehler beim Kompilieren: Variable nicht definiert.
Markiert wird das i bei der Zeile: For i = 1 To 256
Was muss ich hier noch ändern?
Ansonsten habe ich mir das genau so vorgestellt, hier kann ich auch als VBA-Null meine entsprechenden Formatierungen leicht ändern.
Servus, Walter
AW: Codeergänzung für Formatänderung
26.07.2010 12:01:44
Dirk
Hallo!
Fuege nach sub Formatieren() folgende Zeile ein:
Dim i as long
Dann sollte das gehen.
Dirk aus Dubai
AW: Codeergänzung für Formatänderung
26.07.2010 13:53:01
WalterK
Hallo Dirk,
jetzt läuft der Code zwar durch, es tut sich aber nichts.
Wird im Code schon berücksichtigt, dass die Überschriften in der Zeile 2 stehen?
Ich habe mal geraten und dafür die Zeile Select Case Cells(1, i) in Select Case Cells(2, i) geändert: das hat aber auch nicht geholfen.
Servus, Walter
Anzeige
AW: Codeergänzung für Formatänderung
26.07.2010 14:01:53
Dirk
Hallo Walter,
kopiere doch mal Deinen kompletten Code in den post, damit man das mal durchgehen kann.
gruss
dirk aus Dubai
Hier der gesamte Code:
26.07.2010 14:14:37
WalterK
Hallo Dirk,
hier der gesamte Code, vielleicht nicht schön aber zweckmäßig:
Option Explicit
Sub Tabelleeinrichten()
Dim lngA As Long
Dim i As Long
Application.ScreenUpdating = False
Columns("A:AZ").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Selection.Font
.Name = "Tahoma"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWindow.Zoom = 85
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows(1).Insert
lngA = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:AZ2").AutoFilter
With Range("A1")
.FormulaLocal = _
"=WENN(ODER(A2="""";A2=""Datum"";A2=""Geburtsdatum"";A2=""BeginnA2=""Ende"";A2=""Jahr"" _
);"""";" & _
"WENN(ISTZAHL(A3);TEILERGEBNIS(9;A3:A" & lngA & ");""""))"
.NumberFormat = "#,##0.00"
.AutoFill Destination:=Range("A1:AZ1"), Type:=xlFillDefault
End With
Range("A1:AZ1").Select
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
Cells.Select
Selection.NumberFormat = "#,##0.00 _€;[Red]-#,##0.00 _€;"
Range("A1").Select
Range("A2").Select
For i = 1 To 256
Select Case Cells(2, i)
Case "Beginn"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Datum"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Ende"
Columns(i).NumberFormat = "m/d/yyyy"
Case "Mitglied"
Columns(i).NumberFormat = "general"
Case "Sonstiges"
Columns(i).NumberFormat = "general"
End Select
Next
Application.ScreenUpdating = True
End Sub
Besten Dank für's nachschauen,
Servus, Walter
Anzeige
AW: Hier der gesamte Code:
27.07.2010 09:02:18
Yusuf
Moin,
ich kann leider immer nur sporadisch hier reingucken.
Versuch es mal bitte mit der folgenden Schleife.
Ungetestet:
For i = 1 To 256
Select Case Cells(2, i)
Case "Beginn"
Columns(i).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Datum"
Columns(i).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Ende"
Columns(i).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Mitglied"
Columns(i).NumberFormat = "general"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Sonstiges"
Columns(i).NumberFormat = "general"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
End Select
Next
Die Aenderung in "Select Case Cells(2, i)" ist vollkommen richtig.
Gruß
Yusuf
Anzeige
Noch eine Frage ..
27.07.2010 09:49:52
WalterK
Hallo Mustafa,
zum testen habe ich Deinen Code jetzt einmal ohne ihn in meinen Code einzubauen ausprobiert und das funktioniert schon mal sehr gut.
Eine Sache ist aber noch:
Es wird auch die Zeile 1 und 2 mitformatiert, das sollte aber erst ab Zeile 3 passieren.
Kann man das noch ändern?
Besten Dank für Deine Mühe,
Servus Walter
AW: Noch eine Frage ..
27.07.2010 10:00:27
Yusuf
Moin Detlef,
so vielleicht.
Dritte bis 65536. Zeile
For i = 1 To 256
Select Case Cells(2, i)
Case "Beginn"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Datum"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Ende"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Mitglied"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Sonstiges"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Columns(i).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
End Select
Gruß
Yusuf
Anzeige
AW: Noch eine Frage ..
27.07.2010 10:29:29
WalterK
Hallo Mustafa,
ich heiße zwar nicht Detlef aber das passt schon.
Die Formatierungen in Zeile 1 und 2 verändern sich jetzt nicht mehr, das ist jetzt OK.
Allerdings - und das ist eigenartig - werden die in Zeile 1 befindlichen Formeln in den Spalten, in denen es ab Zeile 3 Änderungen ergeben haben, in Englisch und sichtbar angeführt.
Vielleicht dast Du dafür auch noch eine Idee, ansonsten bin ich schon sehr zufrieden und bedanke mich für Deine Hilfe.
Servus, Walter
AW: Noch eine Frage ..
27.07.2010 10:33:27
Yusuf
Hallo Walter,
ich heisse auch nicht Mustafa.
So sollte es gehen denke ich.
For i = 1 To 256
Select Case Cells(2, i)
Case "Beginn"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Datum"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Ende"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Mitglied"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Sonstiges"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(1, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
End Select
Next
Gruß
Yusuf
Anzeige
Es funktioniert noch nicht ...
27.07.2010 11:05:44
WalterK
Hallo Yusuf,
jetzt ist es so, dass in den Spalten, in denen Formatierungen geändert werden, alle Zellinhalte 2 Zeilen nach oben verrutschen, also Zeile 3 zur Zeile 1, Zeile 4 zur Zeile 2 usw.
Die in Zeile 1 befindlichen Formeln werden durch diese Zellinhalte überschrieben.
Servus, Walter
poe a poe, sry
27.07.2010 11:13:34
Yusuf
Moin,
For i = 1 To 256
Select Case Cells(2, i)
Case "Beginn"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(3, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Datum"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(3, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Ende"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(3, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Mitglied"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(3, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Case "Sonstiges"
Range(Cells(3, i), Cells(65536, i)).NumberFormat = "m/d/yyyy"
Range(Cells(3, i), Cells(65536, i)).TextToColumns Destination:=Cells(3, i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
End Select
Next
Bin nun erst mal nicht mehr im Forum, kann erst morgen wieder reingucken.
Gruß
Yusuf
Anzeige
Jetzt passt es ...
27.07.2010 11:25:29
WalterK
Hallo Yusuf,
besten Dank für Deine Geduld und Mühe. Jetzt ist es so wie ich es haben wollte.
Servus, Walter

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige