Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins

Suche in Beispielen und Tipps zu Excel und VBA

Suchbegriff(e) mit Leerzeichen getrennt:

Application-EreignisseMakro/Sub/ProzedurTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 97) Nachricht zum Beitrag an Autor Nach oben

Application-Ereignisse gelten für die gesamte Anwendung, für alle Fenster, Arbeitsmappen und Tabellenblätter. Um mit Ereignissen des Application-Objekts zu arbeiten, muß man zuvor eine öffentliche Variable der Objektklasse in einem Klassenmodul definieren und danach ein Objekt der neuen Klasse und darin wieder ein Objekt der Klasse. Letzteres wird wiederum in einem einfachen Modul erstellt.

Was sich zunächst ein wenig kompliziert anhört, ist im Grunde recht einfach zu verwirklichen.

  1. Man wechselt in den Visual-Basic-Editor und geht auf Einfügen/Klassenmodul. Das Klassenmodul trägt den Namen Klasse1. Diesen wechselt man unter Eigenschaften/Namen in Anwendungsklasse. Dies bietet später eine bessere Übersicht, sollte man noch weitere Klassen definieren.
  2. Die öffentliche Variable wird definiert. Dazu gibt man folgenden Code ein: Public WithEvents Anwendung As Application. Danach stehen schon die Application-Ereignisse im rechten Listenfeld zur Verfügung. Diese erhält man, wenn man im linken Listenfeld auf "Anwendung" wechselt.
  3. Nun wird ein Objekt der neuen Klasse definiert. Dies geschieht in einem allgemeinen Modul (Einfügen/Modul): Dim Anwendungsobjekt As New Anwendungsklasse.
  4. Nun wird unter der Deklaration des Objekts "Anwendungsobjekt" eine Prozedur erstellt, die der Variablen Anwendung der Anwendungsklasse einen Verweis auf das Anwendungsobjekt zuweist:

Sub ObjektZuordnen() Set Anwendungsobjekt.Anwendung = Application End Sub

Ab sofort können alle Ereignisse des Application-Objektes empfangen werden, wenn diese Routine ausgeführt wurde. Damit das neue Objekt immer zur Verfügung steht, sollte der letzte Code in Workbook_Open() der Mappe.

Wir können nun zum Besipiel jeden Blattwechsel in jeder offenen Mappe abfangen (also nicht nur in der mit dem Code), indem wir in das Klassenmodul eintragen:

Private Sub Anwendung_SheetActivate(ByVal Sh As Object) MsgBox Sh.Name End Sub

Hinweis:
Um Application-Ereignisse zu deaktivieren, setzt man einfach den Verweis auf das "Anwendungsobjekt" auf Nothing, also Set Anwendungsobjekt.Anwendung = Nothing

Parameter:

Die Application-Ereignisse haben feste Parameter, die mit übergeben werden (im vorigen Code-Beispiel ist das schon an ByVal Sh As Object zu sehen):

Wb:Stellt die aktive Arbeitsmappe dar.
Sh:Steht für das aktive Tabellenblatt.
Target:Bezieht sich auf den aktiven Zellenbereich.
Cancel:Hat den Wert False. Wird er in der Ereignisprozedur (z. B. bei BeforeSave) auf True gesetzt, wird das Ereignis nicht ausgeführt, sprich es wird nicht gespeichert. U. a. lässt sich so auch gut das Schließen einer Mappe abfangen.

Ereignisse:

Am einfachsten wählt man die natürlich über das Dropdown im Klassenmodul, wie es in der obigen Abbildung dargestellt ist. Hier eine kleine Übersicht:

Anwendung_NewWorkbook(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde eingefügt.
Anwendung_SheetActivate(ByVal Sh As Object)
Ein anderes Blatt wurde aktiviert (Blattwechsel).
Anwendung_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
Doppelklick wurde ausgeführt.
Anwendung_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean)
Klick mit der rechten Maustaste.
Anwendung_SheetCalculate(ByVal Sh As Object)
Neuberechnung eines Tabellenblattes.
Anwendung_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Zelleninhalt eines Tabellenblattes wurde verändert.
Anwendung_SheetDeactivate(ByVal Sh As Object)
Ein Tabellenblatt wurde verlassen (Blattwechsel).
Anwendung_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Zellenmarkierung eines Tabellenblattes wurde geändert.
Anwendung_WindowActivate(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Ein neues Fenster wurde aktiviert (Fensterwechsel).
Anwendung_WindowDeactivate(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Ein Fenster wurde verlassen (Fensterwechsel).
Anwendung_WindowResize(ByVal Wb As Excel.Workbook, ByVal Wn As Excel.Window)
Die Größe eines Fensters wurde verändert.
Anwendung_WorkbookActivate(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde aktiviert (Arbeitsmappenwechsel).
Anwendung_WorkbookAddinInstall(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde als Add-In installiert.
Anwendung_WorkbookAddinUninstall(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde als Add-In deinstalliert.
Anwendung_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, Cancel As Boolean)
Eine Arbeitsmappe soll geschlossen werden.
Anwendung_WorkbookBeforePrint(ByVal Wb As Excel.Workbook, Cancel As Boolean)
Eine Arbeitsmappe soll ausgedruckt werden.
Anwendung_WorkbookBeforeSave(ByVal Wb As Excel.Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Eine Arbeitsmappe soll geschlossen werden.
Anwendung_WorkbookDeactivate(ByVal Wb As Excel.Workbook)
Eine Arbeitsmappe wurde verlassen (Arbeitsmappenwechsel).
Anwendung_WorkbookNewSheet(ByVal Wb As Excel.Workbook, ByVal Sh As Object)
In einer Arbeitsmappe wurde ein neues Tabellenblatt eingefügt.
Anwendung_WorkbookOpen(ByVal Wb As Excel.Workbook)
Eine neue Arbeitsmappe wurde geöffnet.

Aus Blättern einzelne Dateien erstellen

Kategorie: Add-In ▸ Dateien und Ordner

(Tipp 578) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Wie kann ich aus Tabellenblättern einzelne Dateien erstellen?

Das Add-In fragt zunächst nach dem Ordner, in den die einzelnen Dateien gespeichert werden sollen. Dann werden die einzelnen Blätter unter deren Namen mit der Endung xlsx (kann im Code geändert werden) gespeichert, wobei geprüft wird, ob eine Datei mit diesem Namen im Ordner bereits existiert. Zum Anschluss kommt eine Erfolgsmeldung oder die Information, welche Blätter nicht gespeichert werden konnten.

Der Aufruf erfolgt im Menüband im Ribbon JL-Dateien erstellen.

Download: blaetter_speichern.xlam

Blattnamen durch Klick auf Kombinationsfeld einfügenMakro/Sub/ProzedurTipp

Kategorien: Steuerelemente ▸ ActiveX und Mappe ▸ Tabellen

(Tipp 152) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich auf einem Blatt ein Kombinationsfeld erstellen, in dem die Namen der Blätter enthalten sind? Durch Klick in das Kombinationsfeld soll der angeklickte Name in A1 erscheinen.

  • Menüband Entwicklertools einblenden (Rechtsklick in leere Stelle des Menübands und Menüband anpassen)
  • Einfügen ▸ ActiveX-Steuerelemente ▸ Kombinationsfeld
  • Kombinationsfeld zeichnen
  • Doppelklick auf das Feld, dadurch wird der VBA-Editor geöffnet
  • folgenden Code eingeben (Zelle anpassen):

Private Sub ComboBox1_Change() Range("A1") = ComboBox1.Text End Sub[/vbacode]

  • Menü Einfügen - Modul
  • folgendes Makro eingeben (dient zum Füllen des Kombinationsfeldes):

Sub Fuellen() Dim intI As Integer Sheets("Tabelle1").ComboBox1.Clear For intI = 1 To Sheets.Count Sheets("Tabelle1").ComboBox1.AddItem (Sheets(intI).Name) Next End Sub

Durch den Aufruf des Makros Fuellen wird das Kombinationsfeld gefüllt; nach der Auswahl eines Blattes erscheint dessen Name im Beispiel in A1.

Blätter sortierenMakro/Sub/Prozedur

Kategorie: Mappe ▸ Tabellen

(Tipp 108) Nachricht zum Beitrag an Autor Nach oben

Die Tabellenblätter einer Mappe sind mit Tab1, Tab2, ..., Tab50, Tab51, usw. durchnummeriert. Wie kann ich sie sortieren?

Zum Sortieren der Blätter gibt es verschiedene Möglichkeiten, was auch etwas von den Rahmenbedingungen abhängig ist. Was soll zum Beispiel mit Blättern passieren, deren Namen nicht der Syntax der zu sortierenden Blattnamen entsprechen? Hier sind drei Beispiele, die ggf. noch angepasst werden müssen.

In dem Fall werden unterwegs (also nicht am Anfang) Blätter mit Namen, die nicht der Syntax entsprechen, nach hinten verschoben - ansonsten wird so lange sortiert, bis die Zahl im folgenden Blattnamen nicht mehr gößer ist:

Sub BlaetterSortieren() Dim bolSortiert As Boolean Dim intBlatt As Integer, intBlatt1 As Integer Dim varAkt, varNaechst bolSortiert = False Do While bolSortiert = False bolSortiert = True For intBlatt = 1 To Sheets.Count varAkt = Replace(Sheets(intBlatt).Name, "Tab", "") If IsNumeric(varAkt) Then For intBlatt1 = intBlatt To Sheets.Count varNaechst = Replace(Sheets(intBlatt1).Name, "Tab", "") If IsNumeric(varNaechst) Then If varNaechst * 1 < varAkt * 1 Then Sheets(intBlatt1).Move Before:=Sheets(intBlatt) bolSortiert = False End If Else Sheets(intBlatt1).Move after:=Sheets(Sheets.Count) End If Next End If Next Loop End Sub

Ein Beispiel mit Sprungmarken, Reihenfolge Tab1, Tab2, Tab11:

Sub Blattsort() Dim intAnzahl As Integer, intN As Integer, intM As Integer, intI As Integer, intZahlM As Integer, intZahlN As Integer Dim WS As Worksheet intAnzahl = ActiveWorkbook.Worksheets.Count For intM = 1 To intAnzahl For intN = intM To intAnzahl On Error Resume Next For intI = 1 To Len(Worksheets(intN).Name) If IsNumeric(Right(Worksheets(intN).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlN = Right(Worksheets(intN).Name, intI) Exit For End If Next intI For intI = 1 To Len(Worksheets(intM).Name) If IsNumeric(Right(Worksheets(intM).Name, intI)) = False Then intI = intI - 1 If intI = 0 Then GoTo TEXT intZahlM = Right(Worksheets(intM).Name, intI) Exit For End If Next intI If CInt(intZahlN) < CInt(intZahlM) Then Worksheets(intN).Move Before:=Worksheets(intM) GoTo NAECHSTE TEXT: If Worksheets(intN).Name < Worksheets(intM).Name Then Worksheets(intN).Move Before:=Worksheets(intM) NAECHSTE: Next intN Next intM MsgBox "Anzahl der Tabellen: " & intAnzahl End Sub

Ein kurzes Beispiel, aber die Reihenfolge ist Tab1, Tab11, Tab2:

Sub Blattsort1() Dim intX As Integer Dim bolY As Boolean Do bolY = True For intX = 1 To Sheets.Count - 1 If Sheets(intX).Name > Sheets(intX + 1).Name Then Sheets(intX + 1).Move Before:=Sheets(intX) bolY = False End If Next intX Loop Until bolY = True End Sub

Daten von mehreren Blättern zusammenfassenMakro/Sub/Prozedur

Kategorie: Mappe ▸ Tabellen

(Tipp 115) Nachricht zum Beitrag an Autor Nach oben

Ich habe mehrere Blätter mit Daten. Alle Blätter haben unterschiedlich viele Datensätze (Datenzeilen). Alle Daten sollen nacheinander auf einem Blatt zusammengefaßt werden.

Der Code löscht zunächst das Blatt Zusammenfassung, falls es existiert. Alternativ können natürlich auch Zellen oder Zellinhalte dieses Blattes gelöscht werden.

Anschließend läuft im Beispiel eine Schleife über die ersten drei Tabellenblätter. Von denen werden die Zellen in den Spalten 1 bis 5 bis zur letzten (in Spalte 1) ausgefüllten Zeile genommen und untereinander auf das Blatt Zusammenfassung kopiert.

Sub speichern() Dim lngZeile As Long, lngLetzteZ As Long, bytI As Byte Dim strBereich As String On Error Resume Next Worksheets("Zusammenfassung").Delete 'Auswertungsblatt löschen On Error GoTo 0: Err.Clear Worksheets.Add after:=Sheets(Sheets.Count) 'Auswertungsblatt einfügen ActiveSheet.Name = "Zusammenfassung" 'Variable, die dafür sorgt, daß die zusammengefaßten Daten untereinander stehen lngZeile = 1 'hier ab Zeile 1 For bytI = 1 To 3 'Von Blatt 1 bis Blatt 3 zusammenfassen lngLetzteZ = Worksheets(bytI).Cells(Worksheets(bytI).Rows.Count, 1).End(xlUp).Row strBereich = Range(Cells(1, 1), Cells(lngLetzteZ, 5)).Address 'Datenbereich (hier bis Spalte 5) auswählen Worksheets(bytI).Range(strBereich).Copy Sheets("Zusammenfassung").Cells(lngZeile, 1) 'Variable Zeile erhöhen lngZeile = lngZeile + lngLetzteZ Next End Sub

Menü Extras ein Menü hinzufügenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 41) Nachricht zum Beitrag an Autor Nach oben

Wie fügt man dem Menü Extras der Menüleiste für Tabellenblätter ein Menüelement mit dem Namen "Ton" hinzu und bindet dieses an die Prozedur "Ton"?

Sub MenuelementHinzu() MenuBars(xlWorksheet).Menus("Extras").MenuItems.Add Caption:="To&n", OnAction:="Ton" End Sub Sub Ton() Dim intI As Integer For intI = 1 To 10 Beep Next End Sub



Menü Format wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 52) Nachricht zum Beitrag an Autor Nach oben

Wie kann man ein Menü in der Menüleiste für Tabellenblätter wiederherstellen, nachdem es irgendwann zuvor gelöscht wurde, zum Beispiel Format?

Hinweis zu Excel 2007: Entfällt, da es das Menü nicht mehr gibt.

Sub MenueWiederherstellen() MenuBars(xlWorksheet).Menus.Add Caption:="Format", Before:=4, Restore:=True End Sub

Menü im Menü Extras deaktivierenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 42) Nachricht zum Beitrag an Autor Nach oben

Wie deaktiviert man das Menüelement mit dem Namen "Ton" aus dem Menü Extras der Menüleiste für Tabellenblätter, so daß es abgeblendet erscheint?

Setzt man Enabled = True ist das Element wieder wählbar.

Sub MenuelementDeAktivieren() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Enabled = False End Sub Sub MenuelementAktivieren() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Enabled = True End Sub

Menü im Menü Extras löschenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 44) Nachricht zum Beitrag an Autor Nach oben

Wie löscht man das Menüelement mit dem Namen "Ton" aus dem Menü Extras der Menüleiste für Tabellenblätter?

Sub MenuelementLoeschen() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Delete End Sub

Menü löschenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 47) Nachricht zum Beitrag an Autor Nach oben

Wie kann man ein Menü mit dem Namen "MeinMenü" in der Menüleiste für Tabellenblätter löschen?

Sub MenueLoeschen() MenuBars(xlWorksheet).Menus("MeinMenü").Delete End Sub

Menü mit Häkchen versehenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 43) Nachricht zum Beitrag an Autor Nach oben

Wie versieht man das Menüelement mit dem Namen "Ton" aus dem Menü Extras der Menüleiste für Tabellenblätter mit einem Häkchen?

Wird Checked auf False gesetzt verschwindet das Häckchen.

Sub MenuelementHaekchen() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Checked = True End Sub Sub MenuelementKeinHaekchen() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Checked = False End Sub

Menü vor Hilfemenü hinzufügenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 46) Nachricht zum Beitrag an Autor Nach oben

Wie kann man ein Menü mit dem Namen "MeinMenü" in die Menüleiste für Tabellenblätter vor dem Hilfemenü hinzufügen?

Sub MenueHinzu() MenuBars(xlWorksheet).Menus.Add Caption:="Me&inMenü", Before:="?" End Sub

Menüelement Zelle im Menü Format wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 51) Nachricht zum Beitrag an Autor Nach oben

Wie kann man das Menüelement "Zelle" im Menü Format der Menüleiste für Tabellenblätter wiederherstellen, nachdem es irgendwann zuvor gelöscht wurde?

Hinweis zu Excel 2007: Entfällt, da es das Menü nicht mehr gibt.

Sub MenueelementWiederherstellen() MenuBars(xlWorksheet).Menus("Format"). MenuItems.Add Caption:="Zelle", Restore:=True End Sub



Standard-Menüleiste für Tabellenblätter wiederherstellenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 53) Nachricht zum Beitrag an Autor Nach oben

Wie kann man die Standard-Menüleiste für Tabellenblätter wiederherstellen?

Sub MenueleisteWiederherstellen() MenuBars(xlWorksheet).Reset End Sub

Suche über mehrere BlätterMakro/Sub/Prozedur

Kategorie: Suchen/Ersetzen

(Tipp 121) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich auf allen zur Mappe gehörenden Blättern suchen und ersetzen?

In Inputboxen werden zu suchender Text und neuer Text eingegeben. Anschließend wird auf jedem Tabellenblatt der Mappe die Ersetzung durchgeführt.

Sub suchersetz() Dim strSuchBegriff As String, strErsetzBegriff As String Dim wks As Worksheet strSuchBegriff = Application.InputBox("Bitte den zu suchenden Begriff eingeben") strErsetzBegriff = Application.InputBox("Bitte den Ersatzbegriff eingeben") For Each wks In ActiveWorkbook.Worksheets wks.UsedRange.Replace what:=strSuchBegriff, replacement:=strErsetzBegriff, lookat:=xlPart, searchOrder:=xlByColumns, MatchCase:=False Next End Sub

Ggf. kann hier noch eine Fehlerbehandlung eingebaut werden, wenn zum Beispiel eine InputBox abgebrochen wurde.

Summe aus A1 von allen BlätternMakro/Sub/Prozedur

Kategorie: Mappe ▸ Tabellen

(Tipp 114) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich die Summe von A1 aus jedem Blatt bilden?

Beispielsweise durch eine Schleife über die Blätter der Mappe:

Sub Addieren() Dim dblSummen As Double, intI As Integer dblSummen = 0 For intI = 1 To Worksheets.Count dblSummen = dblSummen + Worksheets(intI).Range("A1") Next MsgBox dblSummen End Sub

Tabellenblatt auf mehrere Tabellenblätter aufteilen (EINDEUTIG(), FILTER())Makro/Sub/ProzedurArrayfunktion/Matrixfunktion

Kategorien: Mappe ▸ Tabellen und Tabelle ▸ Matrix

(Tipp 551) Nachricht zum Beitrag an Autor Nach oben

Auf einem Tabellenblatt befinden sich in Spalte C die Namen der Mitarbeiter, daneben ihre Daten. Für jeden Mitarbeiter kann es mehrere Zeilen geben. Wie kann ich für jeden Mitarbeiter ein neues Blatt per VBA erstellen, auf dem seine Daten untereinander aufgelistet sind?

Einsatz dynamischer Arrayfunktionen

Ein Lösungsansatz, der allerdings erst ab Excel 365 funktioniert, ist der Einsatz dynamischer Arrayfunktionen. Dadurch können die Daten vorgefiltert werden und per Schleife müssen nur noch die jeweiligen Ergebnismengen verarbeitet werden; eine Schleife über alle Zeilen ist nicht notwendig.

Gegeben ist die Tabelle mit den Namen in Spalte C ab Zeile 2 und Daten bis zur Spalte G. Dies müsste ggf. angepasst werden. Die letzte Zeile der Tabelle wird aufgrund der Daten in C automatisch erkannt.

Zuerst kommt die Tabellenblattfunktion EINDEUTIG() (UNIQUE()) zum Zug. Sie enthält jeden Namen aus Spalte C genau einmal. Dies ist wichtig, da für jeden Mitarbeiter ja nur ein Blatt erstellt werden soll. Über das Ergebnis dieser Formel kann dann die Hauptschleife laufen: For Each varName In varNamen

In der Schleife wird dann für jeden Namen wieder eine Arrayfunktion verwendet: FILTER(). Diese liefert einen Array, der bei mehreren Zeilen zum Mitarbeiter aus diesen Zeilen mit den Zellen besteht oder bei nur einer Zeile aus den einzelnen Zellen. Damit hier kein Fehler auftritt, wird mit If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then geprüft, wie viele Elemente der Array hat. Ist die Größe des Arrays gleich der Anzahl der einzelnen Elemente, handelt es sich um eine Zeile; die Elemente sind die Zellen. Ist die Größe des Arrays kleiner als die Anzahl der einzelnen Elemente, handelt es sich um mehrere Zeilen.

Beispiel: Bei zwei Zeilen ist der Ubound = 2. Jede Zeile hat vier Zellen, also sind das 2 Zeilen * 4 Zellen = 8 Elemente. Ubound ist kleiner als die Anzahl der Elemente. Bei nur einer Zeile hat der Array vier Elemente (die Zellen eben). Da der Array hier nicht nach Zeilen untergliedert ist, sondern die Zellen in der ersten Ebene liegen, ist hier Ubound auch = 4.

Diese Arrayelemente werden dann nur noch auf das hinzugefügte Blatt eingelesen.

Der Code:

Sub Aufteilen_Filter() Dim lngZ As LongPtr, lngLZ As LongPtr, intZ As Integer Dim strAktBlatt As String, strFormel As String Dim wksNeu As Worksheet Dim varFilt, varNamen, varName strAktBlatt = "Mitarbeiter" lngLZ = Cells(Rows.Count, 3).End(xlUp).Row varNamen = Application.WorksheetFunction.Unique(Range("C2:C" & lngLZ)) If IsArray(varNamen) Then For Each varName In varNamen strFormel = "=FILTER(" & strAktBlatt & "!C2:G" & lngLZ & "," & strAktBlatt & "!C2:C" & lngLZ & "=""" & varName & """)" varFilt = Application.Evaluate(strFormel) If IsArray(varFilt) Then Set wksNeu = Worksheets.Add(after:=Sheets(Sheets.Count)) wksNeu.Name = varName Sheets(strAktBlatt).Range("C1:G1").Copy wksNeu.Range("C1") lngZ = 1 If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then lngZ = lngZ + 1 For intS = 1 To UBound(varFilt) wksNeu.Cells(lngZ, intS + 2) = varFilt(intS) '+2 weil Spalte C Next Else For intZ = 1 To UBound(varFilt) lngZ = lngZ + 1 For intS = 1 To 5 wksNeu.Cells(lngZ, intS + 2) = varFilt(intZ, intS) Next Next End If End If Next End If End Sub


Schleife

Vor Excel 365 funktioniert die Variante mit den dynamischen Arrayfunktionen noch nicht. Deshalb hier noch eine ältere Möglichkeit:

Die Routine duchläuft die Spalte der Mitarbeiternamen von oben nach unten. Mit Hilfe der ZÄHLENWENN-Funktion wird geprüft, ob sich unterhalb der gerade durchlaufenen Zelle der Name des Mitarbeiters nochmals befindet. Wenn nicht, wird ein neues Blatt mit dem Namen des Mitarbeiters angelegt und es werden die Spaltenüberschriften eingefügt.

Zum Schluss werden die Daten zu den Mitarbeitern auf deren Blättern eingetragen.

Sub Aufteilen_Schleife() Dim lngZ As Long, lngLZ As Long, intAnzahl As Integer Dim lngAktZeile As Long Dim strAktBlatt As String, strName As String Dim ints, intAnzahlTB, intAnzahlSpalten As Integer Dim objNeuBlatt As Worksheet Dim lngErsteZeile As Long Dim strSpalte As String 'Hier anpassen: lngErsteZeile = 2 strSpalte = "C" strAktBlatt = ActiveSheet.Name lngLZ = Range(strSpalte & 65536).End(xlUp).Row 'Blätter mit den Spaltenüberschriften erstellen: For lngZ = lngErsteZeile To lngLZ If Sheets(strAktBlatt).Range(strSpalte & lngZ) <> "" Then intAnzahl = Application.WorksheetFunction.CountIf(Sheets(strAktBlatt).Range(strSpalte & lngZ + 1 & ":" & strSpalte & "65536"), Sheets(strAktBlatt).Range(strSpalte & lngZ)) If intAnzahl = 0 Then Set objNeuBlatt = Worksheets.Add(after:=Sheets(Sheets.Count)) objNeuBlatt.Name = Sheets(strAktBlatt).Range(strSpalte & lngZ) For ints = 1 To Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column objNeuBlatt.Cells(1, ints) = Sheets(strAktBlatt).Cells(1, ints) Next ints End If End If Next lngZ 'Übernahme der Daten auf die einzelnen Blätter: intAnzahlSpalten = Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column For lngZ = lngErsteZeile To lngLZ strName = Sheets(strAktBlatt).Range(strSpalte & lngZ) If strName <> "" Then lngAktZeile = Sheets(strName).Range(strSpalte & 65536).End(xlUp).Row + 1 Sheets(strName).Range(Sheets(strName).Cells(lngAktZeile, 1), Sheets(strName).Cells(lngAktZeile, intAnzahlSpalten)).Value = _ Sheets(strAktBlatt).Range(Sheets(strAktBlatt).Cells(lngZ, 1), Sheets(strAktBlatt).Cells(lngZ, intAnzahlSpalten)).Value End If Next lngZ End Sub

Untermenü umbenennenMakro/Sub/Prozedur

Kategorie: Menü ▸ Veraltet

(Tipp 45) Nachricht zum Beitrag an Autor Nach oben

Wie benennt man das Menüelement mit dem Namen "Ton" aus dem Menü Extras der Menüleiste für Tabellenblätter um in Piep?

Sub MenuelementUmbenennen() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Ton").Caption = "Piep" End Sub Sub MenuelementUmbenennen1() MenuBars(xlWorksheet).Menus("Extras").MenuItems("Piep").Caption = "Ton" End Sub

Werte aus den ersten 10 Tabellenblättern in den EditorMakro/Sub/Prozedur

Kategorien: Mappe ▸ Tabellen und Übergreifend

(Tipp 34) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich von den ersten zehn Tabellenblättern die Werte aus jeweils A1 untereinander in den Editor einfügen?

Eine Möglichkeit ist, diese direkt in den Editor einzufügen - allerdings per Tastensimulation. Das geht sicher schnell, allerdings ist danach immer die Num-Taste ausgeschaltet:

Sub InTextExportieren() Dim intI As Integer Shell "Notepad.exe", 3 Application.SendKeys "Sicher ist die Num-Taste jetzt ausgeschaltet.~" For intI = 1 To 10 Application.SendKeys Sheets(intI).Range("A1").Value & "~" Next End Sub

Die bessere Alternative ist, die Werte in eine Textdatei zu speichern und anschließend diese Textdatei mit Notepad aufzurufen:

Sub InTextExportieren1() Dim intI As Integer, strPfad As String, lngDNr As LongPtr strPfad = ThisWorkbook.Path & "\temp.txt" lngDNr = FreeFile Open strPfad For Output As #lngDNr For intI = 1 To 10 Print #lngDNr, Sheets(intI).Range("A1").Value Next Close #lngDNr Shell "Notepad.exe " & strPfad, 3 End Sub

Worksheet-EreignisseMakro/Sub/ProzedurTipp

Kategorien: Basics ▸ Ereignisse und Ereignisse ▸ Basics

(Tipp 99) Nachricht zum Beitrag an Autor Nach oben

Wie der Name schon sagt, geht es bei den Worksheet-Ereignissen um Aktivitäten in Bezug auf das einzelne Tabellenblatt.

Im Visual-Basic-Editor (Alt & F11) wird dazu im Projektfenster auf die jeweilige Tabelle doppelt geklickt und dann von "Allgemein auf "Worksheet gewechselt. Nun stehen im rechten Drop-Down-Feld die Ereignisse zur Verfügung.

Im Gegensatz zu den Workbook-Ereignissen, welche bei allen Tabellenblättern auftreten, sind die Worksheet-Ereignisse an das Tabellenblatt gebunden, indem sie stehen.

Parameterinfo

Bei verschiedenen Prozeduren werden auch Parameter übergeben. Diese verhalten sich wie folgt:

Cancel:Die Boolsche Variabel steht standardmäßig auf False. Setzt man sie auf True, wird das Ereignis nicht mehr ausgeführt. So kann man z. B. das Öffnen des Auswahlmenüs verhindern, indem man Cancel = True innerhalb der Prozedur "BeforeRightClick setzt.
Target:Target steht für den aktiven Bereich und wird häufig dazu benutzt, um den Bereich zum Ausführen eines bestimmten Makros zu bestimmen. So kann man mit: If Target.Address = $A$1 erreichen, daß das Makro nur dann ausgeführt wird, wenn die Zelle A1 aktiv ist.

Ereignisse:

Worksheet_Activate
Tritt ein, wenn das Tabellenblatt aktiviert wird, also Blattwechsel zu diesem Blatt hin.
Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Tritt bei einem Doppelklick innerhalb der Tabelle ein.
Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Tritt bei einem Klick mit der rechten Maustaste innerhalb der Tabelle ein.
Worksheet_Calculate
Tritt ein, wenn Zellen dieses Blattes neu berechnet werden. Dieses Ereignis tritt auch dann ein, wenn sich ein Bezug verändert. Z. B. in B1 steht "= A1" und A1 wird verändert, so wird die Prozedur ausgeführt, da B1 neu berechnet wird.
Worksheet_Change (ByVal Target As Excel.Range)
Tritt ein, wenn mindestens eine Zelle im Tabellenblatt geändert wurde. Leider gibt es immer wieder Probleme bei externen Bezügen, wenn z. B. Daten per DDE geholt werden. Man sollte dann prüfen, ob man nicht mit dem Calculate zum Ergebnis kommt, indem man einen Bezug zur DDE-Zelle herstellt (=A1).
Worksheet_Deactivate
Tritt ein, wenn man von diesem Blatt aus zu einem anderem wechselt.
Worksheet_SelectionChange(ByVal Target As Excel.Range)
Tritt ein, wenn sich die Markierung im Tabellenblatt ändert.