Schlagwort: Makros

Veröffentlicht am

Credits in UserForm

In meinem letzten Beitrag „Dokumenteneigenschaften“ habe ich gezeigt, wie man die Dokumenteneigenschaften per VBA manipulieren kann.

Ich persönlich finde es auch immer ganz schön, wenn man dem Benutzer diese Informationen auch über ein UserForm (falls vorhanden) ausgibt.

Es muss pro Textfeld ein Wert eingetragen werden. Der Textname lässt sich einfach identifizieren, einfach in das Feld klicken.

Der Code, der das Feld mit einem Wert füllt sieht so aus:

UserForm1.TextBox1.Value = "Das ist Text"

In meinem Beitrag „Dokumenteneigenschaften“ habe ich globale Konstanten definiert, die man auch für diesen Zweck verwenden kann.
Dazu erstellen wir ein neues Makro mit dem Namen „CreditNotesEinfügen“

Sub CreditNotesEinfügen()
'
' Credit Notes werden in das Userform geladen
'

UserForm1.TextBox1.Value = "Title: " & Title
UserForm1.TextBox2.Value = "Company: " & Company
UserForm1.TextBox3.Value = "Department: " & Department
UserForm1.TextBox4.Value = "Author: " & Author
UserForm1.TextBox5.Value = "Version: " & Version & " / " & Month & " " & Year
UserForm1.TextBox6.Value = Date
UserForm1.TextBox7.Value = Time
UserForm1.TextBox9.Value = ThisWorkbook.Path
UserForm1.TextBox10.Value = ThisWorkbook.Name
UserForm1.TextBox13.Value = "Contact: " & EMail
End Sub

Zu beachten ist, dass vor einem Aufruf des UserForm die Felder befüllt werden müssen, ansonsten sieht der Benutzer nur ein leeres Feld.

Sub UserForm()
'
' Startet das UserForm
'

Call CreditNotesEinfügen

UserForm.Show
End Sub

Veröffentlicht am

Auswahlbox mit VBA erstellen

Eine Auswahlbox, wie man diese normal über Daten –> Datenüberprüfung erstellen kann, ist mit VBA ein wenig umständlicher zu erstellen.

Auswahl-Dropdown
Auswahl-Dropdown

Option Explicit

Sub Auswahl()    

Dim ws As Worksheet
Dim range1 As Range, rng As Range

ActiveSheet.Range("P7").Value = "ja" ' Darf nicht gelöscht werden
ActiveSheet.Range("P8").Value = "nein" ' Darf nicht gelöscht werden

Set ws = ActiveSheet
Set range1 = ws.Range("P7:P8")
Set rng = ws.Range("P10")

With rng.Validation
    .Delete 'delete previous validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Formula1:="='" & ws.Name & "'!" & range1.Address
End With

End Sub

Veröffentlicht am

Daten aus anderer Arbeitsmappe in aktuelle Tabelle kopieren

Ziel

Man möchte in die aktuell geöffnete Arbeitsmappe in eine bestimmte Tabelle Daten aus einer anderen, Arbeitsmappe aus einer definierten Tabelle kopieren.

Wir unterscheiden einfachheitshalber zwischen

  • Zielarbeitsmappe: Die geöffnete Arbeitsmappe, in die die Daten kopiert werden sollen
  • Quellarbeitsmappe: Die Arbeitsmappe, die die zu kopierenden Daten enthält.

Ausganssituation

Die Zielarbeitsmappe ist geöffnet und die Tabelle in welche die Quelldaten importiert werden sollen, ist bereits vorhanden. Jedoch ist der Name und der Speicherpfad der Arbeitsmappe nicht bekannt und muss erst ermittelt werden.

Die Quellarbeitsmappe ist geschlossen und befindet sich im Unterverzeichnis „Quelle“ der Zielarbeitsmappe. Die Daten befinden sich in der Tabelle1 und sind von dort zu kopieren.

In der Zielarbeitsmappe ist eine Tabelle mit dem Namen „Log“ vorhanden, in das Meldungen geschrieben werden.

VBA-Code

Option Explicit

Sub Import_Rohdaten()

Application.ScreenUpdating = False ' Screenupdating ausschalten

If MsgBox("Bitte prüfen Sie vor dem Beginn der Daten-Imports, dass in der Rohdaten-Datei" _
        & Chr(10) & _
        "nur eine Tabelle mit dem Namen  vorhanden ist." _
        & Chr(10) _
        & Chr(10) _
        & Chr(10) & _
        "Möchten Sie mit dem Import fortfahren?", vbYesNo, "Import Rohdaten") = vbYes Then

Worksheets("Import").Select
Range("A1").Select

    Call ImportiereRohdaten

Else
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen."
Worksheets("Log").Select

End If

Application.ScreenUpdating = True ' Screenupdating einschalten

End Sub


Private Sub ImportiereRohdaten()

Application.ScreenUpdating = False ' Screenupdating ausschalten

    Dim strArbeitsmappe_Pfad As String
    Dim strArbeitsmappe_Name As String
    Dim strArbeitsmappe_Tabellenblatt As String
    Dim strArbeitsmappe As String
    Dim strVerzeichnis As String
    Dim StrDatei As String
    Dim I As Integer
    Dim StrTyp As String
    Dim Dateiname As String
    Dim Dateiname_neu As String
    Dim Zeit As Date
        Dim strQuelle_Workbook As String
    
    ' Definiert den Pfad der geöffneten Arbeitsmappe (= Zielarbeitsmappe)
    ' Der Pfad der geöffneten Arbeitsmappe (= Zielarbeitsmappe) wird jedesmal neu ermittelt.
    strArbeitsmappe_Pfad = ThisWorkbook.Path & ""
    
    ' Definiert den Datei-Namen der geöffneten Arbeitsmappe (= Zielarbeitsmappe)
    ' Der Name wird jedesmal neu ermittelt.
    strArbeitsmappe_Name = ThisWorkbook.Name
    
    ' Definiert das Tabellenblatt in der geöffneten Arbeitsmappe (= Zielarbeitsmappe), in das die Rohdaten importiert werden
    ' Der Name des Tabellenblatts wird jedesmal neu ermittelt.
    ' ACHTUNG: Der Cursor muss sich zwingend in der Tabelle befinden
	  strArbeitsmappe_Tabellenblatt = ActiveSheet.Name ' Ziel-Tabellenblatt
            
    ' Definiert den Quellpfad der die Arbeitsmappe mit Rohdaten (= Quelle) enthält
    ' ACHTUNG: Das Unterverzeichnis ist anzupassen
    strVerzeichnis = ThisWorkbook.Path & "\Quelle"
        
    ' Definiert den Datei-Typ, der die Rohdaten (= Quelle enthält
    StrTyp = "*.xlsx"
    Dateiname = Dir(strVerzeichnis & StrTyp)
    Dateiname_neu = Dateiname
    Zeit = FileDateTime(strVerzeichnis & Dateiname)
    
    ' Definiert den Namen der Arbeitsmappe, die die Rohdaten (= Quelle enthält
    strQuelle_Workbook = strVerzeichnis & Dateiname_neu ' neu
    
    ' Aktiviert die Ziel-Tabelle
    Worksheets(strArbeitsmappe_Tabellenblatt).Activate
    Range("A1").Activate
    
    ' Sucht im Quell-Verzeichnis nach der neuesten Excel-Arbeitsmappe
    Do While Dateiname <> ""
        If Zeit < FileDateTime(strVerzeichnis & Dateiname) Then
            Zeit = FileDateTime(strVerzeichnis & Dateiname)
            Dateiname_neu = Dateiname
        End If
        Dateiname = Dir
    Loop
    
    
    If MsgBox("Es wurde die Datei - " & Dateiname_neu & " - für den Import ausgewählt." & _
        Chr(10) & _
        Chr(10) & _
        "Möchten Sie die Daten importieren?", vbYesNo, "Import Rohdaten") = vbYes Then
        

    ' In der Zielarbeitsmappe wird der Bereich gelöscht
    Sheets(strArbeitsmappe_Tabellenblatt).Select
        ' Ermittelt die letzte befüllte Zelle
        Dim Letzte_Ziel As Long
        Letzte_Ziel = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        ' Ermittelt die letzte befüllte Zelle
    Range("A1:R" & Letzte_Ziel).Select
    Selection.Clear

    ' Öffnet die Arbeitsmappe mit den Rohdaten (= Quelle)
    Workbooks.Open (ThisWorkbook.Path & "\Quelle" & Dateiname_neu)
    Sheets("Tabelle1").Activate
    
            ' Prüft den Spaltennamen in der Quell-Datei auf Übereinstimmungauf
			' Entspricht die Spaltenüberschrift nicht den Vorgaben, wird der Import abgebrochen
            If ActiveSheet.Range("C1").Value = "Spaltenüberschrift" Then
                'MsgBox ("Spaltename C der Rohdaten entspricht den Vorgaben")


    
    ' Ermittelt die letzte befüllte Zelle
    Dim Letzte_Roh As Long
    Letzte_Roh = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ' Ermittelt die letzte befüllte Zelle
    Range("A1:R" & Letzte_Roh).Copy
        
        
    ' Aktiviert die Zielarbeitsmappe und fügt die kopierten Daten ein
    Windows(strArbeitsmappe_Name).Activate
    Worksheets(strArbeitsmappe_Tabellenblatt).Activate
    Range("A1").PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' Wechselt auf die Rohdaten-Datei und schließt diese
    Windows(Dateiname_neu).Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close savechanges:=False

    
    ' Wechselt zur Zielarbeitsmappe und setzt den Cursor in die Zelle A1
    Windows(strArbeitsmappe_Name).Activate
    Worksheets(strArbeitsmappe_Tabellenblatt).Activate
    Range("a1").Select

    ' Schreibt in den Log-Bereich in Tabelle "Dashboard"
    Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import erfolgreich abgeschlossen."
    Worksheets("Log").Select


            ' Wenn der Spaltenname nicht den Vorgaben entspricht, wird der Import abgebrochen
            Else
                    'MsgBox "Abbruch - Falsche Spaltenbenennung."
                    ' Wechselt auf die Rohdaten-Datei und schließt diese
                    Windows(Dateiname_neu).Activate
                    Application.CutCopyMode = False
                    ActiveWorkbook.Close savechanges:=False
                    
                    ' Wechselt zur Zielarbeitsmappe und setzt den Cursor in die Zelle A1
                    Windows(strArbeitsmappe_Name).Activate
                    Worksheets(strArbeitsmappe_Tabellenblatt).Activate
                    Range("a1").Select
                    
                    MsgBox "Daten-Import abgebrochen - Falsche Spaltenbenennung in den Rohdaten. Bitte prüfen Sie das Log-File."
                    
                    Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen - falsche Spaltenbenennung in den Rohdaten. Spalte C <> Spaltenüberschrift."
                    Worksheets("Log").Select
                    
            End If

Else
MsgBox "Der Import wurde abgebrochen."
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen."
Worksheets("Log").Select
    
End If


Application.ScreenUpdating = True ' Screenupdating einschalten

End Sub

Veröffentlicht am

Text in Zahlen umwandeln mit VBA

Text in Zahlen umwandeln - manuell

In einem meiner früheren Post habe ich bereits ein Makro hierfür gepostet ➡ Text in Zahlen umwandeln. Bei diesem Makro wird der zu formatierende Bereich dynamisch ermittelt. Es wird der Bereich A4 bis zu letzten beschriebenen Zelle in eine Zahl umgewandelt, anstatt dies manuell über den grünen Pfeil vorzunehmen, geht das bequem über das Makro. 

Sub text_in_zahl()
    'Das Makro wandelt Text in Zahlen um
   
    Sheets("Tabelle1").Select
    
    ' Die letzte beschriebene Zelle wird ermittelt
    Dim loletzte As Long
    loletzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    
    With Range("a4" & ":a" & loletzte)
        .NumberFormat = "General"
        .Value = .Value
    End With
End Sub

Möchte man die so umgewandelten Zahlen z.B. in ein Datum umwandeln, könnt ihr dieses Makro nutzen:

Sub datum_formatieren()

' Formatiert Zahlen in das Datumsformat mm.dd.yyyy

'
Application.ScreenUpdating = False

    Sheets("Tabelle1").Select
    
    Dim loletzte As Long
    loletzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    Range("a4" & ":a" & loletzte).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy"
    Application.CutCopyMode = False
    
End Sub

Veröffentlicht am

Tabellen nach einer Tabelle in eine Excel Arbeitsmappe einfügen

Das nachfolgende Makro kopiert die Tabelle CW1 und fügt diese nach einer definierten Tabelle in die bestehende Excel-Arbeitsmappe ein.

Der Name der neuen Tabelle beginnt mit einer fest definierten Buchstabenkombination die durch eine vom User eingegebenen Buchstaben oder Zahlenkombination ergänzt wird.

Der vom Benutzer eigegebenen Tabellenname wird zudem in der Zelle B7 ausgegeben.

Sub mod_create_cwtable()
' Das Makro kopiert die Tabelle "CW1" und fügt die Kopie mit einem neuen Namen nach einer definierten Tabelle ein

Dim i As Integer
Dim l As Integer

i = InputBox("Welcher CW soll hinzugefügt werden?")
l = InputBox("Nach welcher CW soll de neue Tabelle hinzugefügt werden?")

Sheets("CW1").Select
ActiveWorkbook.Sheets("CW1").Copy after:=Sheets("CW" & l)
ActiveWorkbook.Sheets("CW1 (2)").Name = "CW" & i
Range("B7").Select
ActiveCell.FormulaR1C1 = i
Range("d7").Select

End Sub

Eingabeaufforderung 1

Tabellen nach einer Tabelle in eine Excel Arbeitsmappe einfügen
Tabellen nach einer Tabelle in eine Excel Arbeitsmappe einfügen

Eingabeaufforderung 2

Tabellen nach einer Tabelle in eine Excel Arbeitsmappe einfügen
Tabellen nach einer Tabelle in eine Excel Arbeitsmappe einfügen
Veröffentlicht am

Leere Zeilen aus Excel Tabellen löschen

Es kommt ja öfters vor, dass in einer Excel Tabelle leere Zeilen enthalten sind, die man nicht gebrauchen kann. Durch leere Zeile lässt sich z.B. kein anständiger Filter setzen, um den Inhalt zu sortieren.

Bevor man nun umständlich mit VBA versucht die leeren Zeilen zu löschen, kann man das auch ganz einfach mit den Excel Bordwerkzeugen machen.

Ich habe in eine Tabelle vorbereitet, in der viele leere Zeilen vorhanden sind, die ich löschen möchte. Um das ein bisschen übersichtlicher zu gestalten, die blauen Zeilen sollen unbedingt erhalten bleiben und die weißen Zeilen dazwischen sollen gelöscht werden.

Leere Zeilen aus Excel Tabelle löschen

Markiert nun die Spalte in der sich die leeren Zellen der Zeile befinden, die ihr entfernen möchtet und drückt dann die Taste F5.
Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Leere Zeilen aus Excel Tabelle löschen

Veröffentlicht am

Formatierung von Zellen

Die Formatierung von Zellen ist mit Hilfe von VBA-Makros ebenso leicht durchzuführen, wie mit Excel selbst.
Am nachfolgenden Beispiel wird erklärt, wie definierte Zellen mit einem Befehl formatiert werden.

Anforderung

  • Formatierung, die durch den Standard-Excel Benutzer nicht geändert werden kann, also sehr schnell wieder hergestellt werden kann.
  • Immer drei nebeneinanderliegende Zellen sollen mit einer unterschiedlichen Hintergrundfarbe formatiert werden.

Beispiel

Das Beispiel baut teilweise auf auf.

Im Screenshot ist die Zeile, die mit dem Makro benannt werden soll farblich hervorgehoben.

In diesem Beispiel wird die neue Benennung der Zellen aufgegriffen, deren Vorteile die bereits im Artikel ausführlich erläutert wurde.

Code: Orange Formatierung

Private Sub KapFarben_orange()                              
' Formatiert die Zellen: Hintergrund, Schriftfarbe, fett

    Range("Kap_7_3:Kap_7_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_5_3:Kap_5_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_3_3:Kap_3_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_1_3:Kap_1_1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With


Die einzelnen Punkt der Formatierung sind ab Besten mit dem Makro-Rekorder aufzuzeichnen und dann anzupassen. Eine manuelle Eingabe ist hier wenig sinnvoll.

Der Code ist in 4 Teile getrennt.

  • Range(„Kap_7_3:Kap_7_1“)
  • Range(„Kap_5_3:Kap_5_1“)
  • Range(„Kap_3_3:Kap_3_1“)
  • Range(„Kap_1_3:Kap_1_1“)

Das bedeutet nicht anderes als die Zusammenfassung der Bereichen Kap_7_3, Kap_7_2, Kap_7_1 zu („Kap_7_3:Kap_7_1“) usw. Grundlage bildet die Benennung der Zellen von C7 zu Kap_7_3.
Die nachfolgenden Abschnitte sind identisch, da die gleiche Formatierung für alle 4 Bereiche gleich sein soll, deshalb sind sie einfach zu kopieren. Die Range ist aber abzuändern.

Nach dem fertigstellen der Makros kann es mit F5 ausgeführt werden. Die Zellen sollten sich dann automatisch formatieren.

Für die blau eingefärbten Zellen ist analog zu verfahren.
➡ Makro-Rekorder
➡ Code anpassen

Verknüpfung

Im Artikel wurde beschrieben, wie die Zellen mit Hilfe eines VBA.Makros beschrieben werden können. Es bietet sich nun an, beide Makros zu verknüpfen. Beide lassen sich sehr leicht verknüpfen. Die Reihenfolge im nachfolgenden Code ist

  1. Beschriftung
  2. Formatierung

      3. Code

      
Option Explicit


Sub KapBennennung()

Dim strRegal7 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal7 = "Regal 7"

Dim strRegal6 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal6 = "Regal 6"

Dim strRegal5 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal5 = "Regal 5"

Dim strRegal4 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal4 = "Regal 4"

Dim strRegal3 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal3 = "Regal 3"

Dim strRegal2 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal2 = "Regal 2"

Dim strRegal1 As String             ' Zur Beschriftung der Zellen mit Regal X
strRegal1 = "Regal 1"

Dim strNum1 As String               ' Zur Beschriftung der Zellen mit -1
strNum1 = "-1"

Dim strNum2 As String               ' Zur Beschriftung der Zellen mit -2
strNum2 = "-2"

Dim strNum3 As String               ' Zur Beschriftung der Zellen mit -3
strNum3 = "-3"


Sheets("Kapazitaet").Select

    Range("Kap_7_3").Value = strRegal7 & strNum3    ' Beschriftet die Zelle Kap_7_3 --> Regal 7-3
    Range("Kap_7_2").Value = strRegal7 & strNum2    ' Beschriftet die Zelle Kap_7_2 --> Regal 7-2
    Range("Kap_7_1").Value = strRegal7 & strNum1    ' Beschriftet die Zelle Kap_7_1 --> Regal 7-1
    
    Range("Kap_6_3").Value = strRegal6 & strNum3
    Range("Kap_6_2").Value = strRegal6 & strNum2
    Range("Kap_6_1").Value = strRegal6 & strNum1

    Range("Kap_5_3").Value = strRegal5 & strNum3
    Range("Kap_5_2").Value = strRegal5 & strNum2
    Range("Kap_5_1").Value = strRegal5 & strNum1
    
    Range("Kap_4_3").Value = strRegal4 & strNum3
    Range("Kap_4_2").Value = strRegal4 & strNum2
    Range("Kap_4_1").Value = strRegal4 & strNum1
        
    Range("Kap_3_3").Value = strRegal3 & strNum3
    Range("Kap_3_2").Value = strRegal3 & strNum2
    Range("Kap_3_1").Value = strRegal3 & strNum1
    
    Range("Kap_2_3").Value = strRegal2 & strNum3
    Range("Kap_2_2").Value = strRegal2 & strNum2
    Range("Kap_2_1").Value = strRegal2 & strNum1
    
    Range("Kap_1_3").Value = strRegal1 & strNum3
    Range("Kap_1_2").Value = strRegal1 & strNum2
    Range("Kap_1_1").Value = strRegal1 & strNum1

Call KapFarben_orange
Call KapFarben_blau

    Range("A1").Select
    
End Sub

Private Sub KapFarben_orange()                              ' Formatiert die Zellen: Hintergrund, Schriftfarbe, fett

    Range("Kap_7_3:Kap_7_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_5_3:Kap_5_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_3_3:Kap_3_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_1_3:Kap_1_1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 45
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
End Sub

    
Private Sub KapFarben_blau()                                                ' Formatiert die Zellen: Hintergrund, Schriftfarbe, fett

    Range("Kap_6_3:Kap_6_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_4_3:Kap_4_1").Select
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
    Range("Kap_2_3:Kap_2_1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
    
        Range("Kap_Summe").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
    Selection.Font.Bold = True
    End With
End Sub

      Mittels Call-Befehl werden die Formatierungsmakros KapFarben_orange und KapFarben_blau zusammen aufgerufen, danach wird der Cursor auf die Zelle A1 gesetzt.

Veröffentlicht am

Ermittlung der letzten befüllten Zeile in einem Tabellenblatt

Mit einem Makro lässt sich in Excel sehr einfach und schnell die letzte beschriebene Zeile in einem Tabellenblatt ermitteln.
Über eine MsgBox wird die Zeilennummer dem User ausgegeben.

Sub Letzte_beschriebene_Zeile()
'
' Das Makro ermittelt die letzte beschriebene Zeile
'
    Dim letzte As Long
    loletzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    MsgBox letzte 
End Sub

Veröffentlicht am

Werte fortlaufend in Zellen eintragen (fortlaufende Nummerierung)

Mit Hilfe eines Makros ist es möglich Werte fortlaufend in eine Spalte schreiben zu lassen.

In diesem Beispiel wird eine fortlaufende Nummerierung in den Bereich H3:H10 eingetragen.

Sub Wertfortlaufend()
' fortlaufendeZahl Makro

Sheets("Grunddaten").Select
Range("h3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Range("h3").Select
Selection.AutoFill Destination:=Range("h3:h10"), Type:=xlFillDefault
Range("h3:h10").Select
End Sub

Der Code fügt automatisch die Zahlen 1 bis 10 in die Zellen h3 bis h10 ein.

Erklärung

  • Sheets.(„Grunddaten“).Select = Grunddaten ist der Name des Tabellenblatts
  • Range(„h3“).Select = Die Zelle H3 wird ausgewählt
  • ActiveCell.FormulaR1C1 = „R[-1]C+1“ = Die definierte Formel (R1[-1]C+1]) wird in die Celle H3 kopiert
  • Danach wird wieder die Zelle H3 ausgewählt und mit der Funktion AutoFill, wird die Formel in der definierten Range H3:H10 herunterkopiert.

Code

Der Code für eine fortlaufende Nummerierung der Spalte A beginnend bei Zelle A2 bis Zelle A65536 lautet

Sub Nummerierung() ' Nummeriert den Bereich A2:A65536 von 1 bis xxx 

Sheets("dbo_ARTIKEL_STAMM Abfrage").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A65536"), Type:=xlFillDefault
Range("A2:A65536").Select
End Sub

Weitere Möglichkeiten

Im nachfolgenden werden nur noch die Formeln gändert. Diese sind dann in das Makro einzusetzen.

  • ActiveCell.FormulaR1C1 = "=R[-1]C+0.5"

    Die Nummerierung erfolgt in 0.5 Schritten, also 0.5, 1, 1.5, 2, etc.

  • ActiveCell.FormulaR1C1 = "=R[-1]C-1"

    Die Nummerierung erfolgt in -1 Schritten, also, -1, -2, -3, etc.

In den nächsten Tagen kommt auch noch ein Artikel, der in Verbindung mit diesem Makro sehr nützlich sein kann ➡ Ermittlung der letzten befüllten Zeile in einem Tabellenblatt