Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Excel-File mit VBA dynamisch formatieren
#1
Hallo,

habe mich jetzt etwas in VBA eingelesen, einige Videos geschaut, aber das will einfach nicht. Habe noch nie etwas mit Programmierung gemacht und bin jetzt also ratlos :16:   Ich bin gerademal dazu gekommen, dass ich ein Makro aufnehmen und abspeichern kann. Und Google will mir da auch nicht wirklich helfen.

Für folgendes suche ich eine Lösung:
Aus unserer WaWi-Datenbank erstelle ich mir eine Liste von Artikeln mit verschiedenen Spalten. Dabei variieren die Spaltenreihenfolge/-anzahl sowie die Zeilenanzahln (Datensätze). Was aber gleich bleibt ist der Spaltenname der einzelnen Spalten. Ich würde nun gerne die Formatierung automatisieren, sodass ich nicht immer dieselben Arbeitsschritte manuell durchgehen muss, bevor ich mit der Liste arbeiten kann.

Mein Makro habe ich folgend aufgenommen, nur macht mir das jetzt nicht die gewünschte Formatierung bei einem anderen File mit mehr Datensätzen/Spalten.



Sub Test_Formatierung()
'
' Test_Formatierung Makro
'
'hinter der letzten Spalte mit Inhalt eine Spalte "Kontrolle" mit fortlaufender Nummerierung bis ans Ende der Tabelle anlegen.
'1 Zeile bis leere/r Datensatz/Zellen fett und grün färben.
'Bereich mit Datensätzen Gitterrahmen geben, Zeilenumbruch und Text im Zeilenbereich oben
'Spalte mit Namen "EK" und "VK" in Währung Euro formatieren.

    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Kontrolle"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("M5").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("M2:M5").Select
    Selection.AutoFill Destination:=Range("M2:M56"), Type:=xlFillDefault
    Range("M2:M56").Select
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-3
    Range("H2").Select
    
    Columns("F:G").Select
    Selection.Style = "Currency"
 
End Sub



Wie kann ich die einzelnen Formatierungsschritte dynamisch machen, sprich die Zeilen namens "EK" und "VK" (steht für Einkaufspreis und Verkaufspreis und sind aktuell oben als F und G filespezifisch angesteuert) ansteuern, sodass ich die bei variierender Spaltenanzahl doch noch formatieren kann?

Und das selbe dann auch mit der restlichen Formatierung.

Freue mich auf jede Hilfe

Lg
Matthias


Angehängte Dateien
.xlsx   Beispieldatei Makroformatierung_nachformatierung.xlsx (Größe: 19,02 KB / Downloads: 4)
.xlsx   Beispieldatei Makroformatierung.xlsx (Größe: 13,9 KB / Downloads: 2)
Antworten Top
#2
Hallo Matthias,

bevor wir uns mit VBA auseinandersetzen erst mal die Frage - kennst Du die "Tabellen" - Funktionalität von Excel (Menü | Einfügen | Tabelle) ? Da kann man eine formatierte Tabelle erstellen die sich automatisch bei Eingabe neuer Datensätze erweitert. Eventuell reicht so etwas schon.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Hi Matthias!
VBA ist sicherlich nichts, was man mit Studium einiger Videos erlernen kann.
(Zumindest traf dies auf mich zu)
Aber wir können dies gerne mal an Deinem Beispiel durchexerzieren.
Ich warte aber zunächst mal auf Deine Reaktion, dann machen wir weiter.

Wie Du selbst gesehen hast, zeichnet der Makrorekorder enorm viel überflüssiges auf.
Ich beginne mal mit Deiner Zahlenreihe in Spalte M:
(Erklärungen im Code)

Sub NrInM()
Dim letzteZeile As Long
With Tabelle1
   letzteZeile = .Range("A1").End(xlDown).Row ' letzte Zeile in Spalte A 
   .Range("M1") = "Kontrolle"
   With .Range("M2:M" & letzteZeile)
      .Formula = "=row()-1" ' entspricht der Formel =ZEILE()-1 
      .Formula = .Value ' tauscht die Formel gegen ihren Wert 
   End With
End With
End Sub

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • mad1111111
Antworten Top
#4
Hi!
Ich habe die Dynamik mal umgesetzt und den Code entschlackt.
Datei im Anhang.

Sub Formatierung()
Dim letzteZeile As Long, letzteSpalte As Integer
Dim EK As Integer, VK As Integer
Application.ScreenUpdating = False ' Bildschirmflackern aus
With Tabelle1
  letzteZeile = .Range("A1").End(xlDown).Row ' letzte Zeile in Spalte A
  letzteSpalte = .Range("A1").End(xlToRight).Column ' letzte Spalte in Zeile 1
  .Cells(1, letzteSpalte + 1) = "Kontrolle"
  With .Range(.Cells(2, letzteSpalte + 1), .Cells(letzteZeile, letzteSpalte + 1))
     .Formula = "=row()-1" ' entspricht der Formel =ZEILE()-1
     .Formula = .Value ' tauscht die Formel gegen ihren Wert
  End With
  With .UsedRange.Rows(1) ' Formatierung der Überschriften
     .Interior.Color = 10213316
     .Font.Bold = True
  End With
  ' Suchen der Spaltennummer für EK und VK
  EK = WorksheetFunction.Match("EK", .UsedRange.Rows(1), 0)
  VK = WorksheetFunction.Match("VK", .UsedRange.Rows(1), 0)
  With .UsedRange
     ' Währungsformat
     .Columns(EK).NumberFormat = "#,##0.00 €"
     .Columns(VK).NumberFormat = "#,##0.00 €"
     ' Rahmen
     .Borders(xlEdgeLeft).ColorIndex = 0
     .Borders(xlEdgeTop).ColorIndex = 0
     .Borders(xlEdgeBottom).ColorIndex = 0
     .Borders(xlEdgeRight).ColorIndex = 0
     .Borders(xlInsideVertical).ColorIndex = 0
     .Borders(xlInsideHorizontal).ColorIndex = 0
     ' Ausrichtung
     .VerticalAlignment = xlTop
     ' Zeilenumbruch
     .WrapText = True
  End With
End With

Gruß Ralf


Angehängte Dateien
.xlsm   Beispieldatei Makroformatierung.xlsm (Größe: 20,32 KB / Downloads: 7)
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • mad1111111
Antworten Top
#5
Nabend!

Gerade durch Zufall entdeckt.
Mich hat dieses zum Darstellen des "Gitternetzes" immer geärgert:

     ' Rahmen 
   With Tabelle1.UsedRange
     .Borders(xlEdgeLeft).ColorIndex = 0
     .Borders(xlEdgeTop).ColorIndex = 0
     .Borders(xlEdgeBottom).ColorIndex = 0
     .Borders(xlEdgeRight).ColorIndex = 0
     .Borders(xlInsideVertical).ColorIndex = 0
     .Borders(xlInsideHorizontal).ColorIndex = 0
   End With

Geht auch anders:

     ' Rahmen 
      Tabelle1.UsedRange.Cells.Borders.ColorIndex = 0

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • mad1111111
Antworten Top
#6
Hallo,

als Tabelle formatieren kenne ich, nützt mir nur in diesem Fall nicht sehr viel, da ich die Datensätze aus der WaWi ja immer aktuell bekomme und sich da einige Dinge ständig ändern (Verfügbarkeit der Artikel, Preise etc.) also muss ich immer mit den aktuellsten Datensätzen arbeiten und da fallen eben dann je nach Informationsexport verschiedene Spalten und Zeilen (Datensätze) an.

Also ist mMn ein Makro zur autom. Formatierung schon sinnvoll. Damit würden dann Arbeitskollegen auch gleich arbeiten können und wir würden uns auf ein Format einigen, mit dem wir dann formatieren und anschließend die Daten - die eigentliche Arbeit - auswerten können.

Danke Ralf für deine Unterstützung. Der Recorder nimmt sehr viel mit, das habe ich auch in Videos und an Beispielen gesehen. Anhand deines Codes kann ich mir jetzt auch mein Beispiel ansehen. Vielen lieben Dank nochmal, dann schaue ich es mir einmal genauer an Smile

Liebe Grüße,
Matthias
Antworten Top
#7
Hi Ralf,

habe das Makro nun auf andere Tabellen angewandt und es funktioniert. Perfekt! Vielen Dank.

Was ich noch hinzufügen wollte, aber nicht schaffte war das färben aller leeren Zeilen in der Tabelle.
Habe folgenden Code im Netz gefunden und wollte ihn auf meine gesamte Tabelle ("Tabelle1" eingetragen) anwenden:



Code:
   With Tabelle1
       .Interior.ColorIndex = xlNone
       .SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3
   End With

Nur kommt da ein Fehler, dass .Interior nicht funktioniert, aber ein Bereich bspw. With [A1:D50] funktioniert.

Könnte das mit Bereich markieren und Bedingte-Formatierungsformel =ISTLEER(A1) lösen, aber das würde ich auch immer brauchen und einige Kollegen kennen die Formel nicht.

Auch bräuchte ich noch folgende Formatierung: Die gesamte Zeile gelb machen, wenn bei Spalte "Auslaufartikel" ein "Ja" steht. (Am besten das vor dem anderen Format "leere Zelle Färben", sodass die leeren Zellen alle rot sind).

Morgen probiere ich noch diese Formatierungen zu recorden und stelle sie hier rein, dann kann ich von lernen Blush
Wenn du mir wieder umschreiben hilfst.
Auch habe ich bei einer des Codes ein Problem (Anwendungsfehler 1004 bei  .Cells(1, letzteSpalte + 1) = "Kontrolle"), wenn ich sie in ein Modul außerhalb der Tabelle speichere und laufen lassen will. Das wird wohl mit "Option Explicit" zusammenhängen oder?

Schönen Abend noch und schönen Feiertag,
Matthias


Angehängte Dateien
.xlsm   Beispieldatei Makroformatierung.xlsm (Größe: 26,91 KB / Downloads: 3)
Antworten Top
#8
Moin!
1. Vor Interior muss ein Range stehen, Tabelle1 ist aber ein Worksheet.
Deshalb: Tabelle1.UsedRange.Cells.Interior.ColorIndex = xlNone
2. Dieses und die umgesetzte ben.def. Formatierung (die ich in Deiner Datei gelöscht habe) habe ich in folgendem Code umgesetzt:

Sub Formatierung()
Dim letzteZeile As Long, letzteSpalte As Integer, cnt As Long
Dim EK As Integer, VK As Integer
Application.ScreenUpdating = False ' Bildschirmflackern aus
With Tabelle1
  letzteZeile = .Range("A1").End(xlDown).Row ' letzte Zeile in Spalte A
  letzteSpalte = .Range("A1").End(xlToRight).Column ' letzte Spalte in Zeile 1
  .Cells(1, letzteSpalte + 1) = "Kontrolle"
  With .Range(.Cells(2, letzteSpalte + 1), .Cells(letzteZeile, letzteSpalte + 1))
     .Formula = "=row()-1" ' entspricht der Formel =ZEILE()-1
     .Formula = .Value ' tauscht die Formel gegen ihren Wert
  End With
  With .UsedRange.Rows(1) ' Formatierung der Überschriften
     .Interior.Color = 10213316
     .Font.Bold = True
  End With
  ' Suchen der Spaltennummer für EK und VK
  EK = WorksheetFunction.Match("EK", .UsedRange.Rows(1), 0)
  VK = WorksheetFunction.Match("VK", .UsedRange.Rows(1), 0)
  With .UsedRange
     ' Währungsformat
     .Columns(EK).NumberFormat = "#,##0.00 €"
     .Columns(VK).NumberFormat = "#,##0.00 €"
     ' Rahmen
     .Cells.Borders.ColorIndex = 0
     ' Ausrichtung
     .VerticalAlignment = xlTop
     ' Zeilenumbruch
     .WrapText = True
     ' Farben entfernen
     .Cells.Interior.ColorIndex = xlNone
     ' Auslauf gelb
     For cnt = 2 To letzteZeile
        If .Cells(cnt, "L") = "Ja" Then _
           .Range(.Cells(cnt, "A"), .Cells(cnt, "L")).Interior.ColorIndex = 6
     Next
     ' Leere rot
     .SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3
  End With
End With
End Sub

Datei im Anhang!

Ergänzend:
Falls sich die Spalte "Auslaufartikel" auch ändern kann, musst Du das analog zum EK/VK machen.
Bin mal gespannt, ob Du das hinbekommst.

Gruß Ralf


Angehängte Dateien
.xlsm   Beispieldatei Makroformatierung.xlsm (Größe: 27,08 KB / Downloads: 12)
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten Top
#9
Als "Geheimtipp"  :05:

Zitat:Dim Auslauf As Integer
     Auslauf = WorksheetFunction.Match("Auslaufartikel", Tabelle1.UsedRange.Rows(1), 0)
     For cnt = 2 To letzteZeile
        If .Cells(cnt, Auslauf) = "Ja" Then _
           .Range(.Cells(cnt, "A"), .Cells(cnt, letzteSpalte)).Interior.ColorIndex = 6
     Next

(Mal sehen, wer das geheime findet …)

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten Top
#10
Moin Ralf,

Thumps_up Thumps_up Thumps_up  :30:
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste