Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA
Add-Ins
Excel/VBA

Excel-Beispiele:
Erklärungen, Formeln, VBA-Code und mehr

Hinweise zu den Beispielen finden Sie hier: Beispiele


Kategorie: Beispiel > Excel > VBA > Mappe (16)

Aktives Blatt: Name

(Tipp 107) Nachricht zum Beitrag an Autor Nach oben

Ich möchte, daß sich bestimmte Makros nur auf Worksheet xxx eines Workbooks auswirken. Wie lautet die Syntax?

Am einfachsten und sichersten ist es natürlich, im relevanten Code das enstprechende Blatt direkt anzusprechen:

Sheets("xxx").irgendwas

Soll geprüft werden, ob es sich beim aktiven Blatt um das Blatt XXX handelt, ist dies möglich:

If ActiveSheet.Name = "XXX" Then ...

Blätter sortieren

(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

Bildschirmaktualisierung aus- und einschalten

(Tipp 109) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich erreichen, daß ein Makro nicht alle einzelnen Schritte anzeigt?

Dazu kann die Bildschirmaktualisierung (das ScreenUpdating) ausgeschaltet werden:

Application.ScreenUpdating = False

Bildschirmaktualisierung einschalten:

Application.ScreenUpdating = True

Das Ausschalten der Bildschirmaktualisierung hat auch immer ein paar Risiken, denn das Excelfenster ist ja dann „eingefroren“. Kommt es zu einem Fehler durch den Code, bleibt das Fenster auch eingefroren - der Anwender sieht dann schlicht keine Veränderungen mehr. Deshalb ist empfehlenswert, durch objektorientiertes Arbeiten (also Elemente direkt ansprechen, Verzicht auf .Select und .Activate) dafür zu sorgen, dass der Bildschirm nicht zappelt.

Soll die Aktualisierung trotzdem ausgeschaltet werden (weil vielleicht die Laufzeit kürzer wird), sollten Fehler abgefangen und per Sprungmarke am Ende des Codes die Bildschirmaktualisierung wieder eingeschaltet werden. Im einfachsten Fall wäre das so möglich:

On Error GoTo FEHLER … Code … FEHLER: Application.ScreenUpdating = True

Günstig ist auch, am Anfang den Status der Eigenschaft abzufragen und sie am Ende wieder so zu setzen, wie sie am Anfang war:

Sub MeinMakro() Dim bolAktScrUpd As Boolean bolAktScrUpd = Application.ScreenUpdating … Code … Application.ScreenUpdating = bolAktScrUpd End Sub



Blatt einfügen

(Tipp 110) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich ein neues Blatt einfügen? Dabei soll überprüft werden, ob ein Blatt mit dem Namen schon existiert und der linke und rechte Seitenrand auf einen Zentimeter festgelegt werden.

In eine Inputbox kann der Name des zu erzeugenden Blattes eingetragen werden. Anschließend wird mit einer Schleife geprüft, ob der Name schon vergeben ist. Wenn nicht, wird das Blatt eingefügt und die Seitenränder werden festgelegt.

Sub Blatterstellen() Dim wksBlatt As Object Dim strNeu As String strNeu = InputBox("Bitte Namen des neuen Arbeitsblattes eingeben:") For Each wksBlatt In ActiveWorkbook.Sheets If wksBlatt.Name = strNeu Then MsgBox "Blattname existiert bereits!", vbOKOnly + vbExclamation, "Blatt hinzufügen" Exit Sub End If Next Sheets.Add ActiveSheet.Name = strNeu With Sheets(strNeu).PageSetup .LeftMargin = Application.CentimetersToPoints(1) .RightMargin = Application.CentimetersToPoints(1) End With End Sub

Eine andere Möglichkeit, bei der auch gleich festgelegt wird, wo das Blatt eingefügt werden soll:

Sub Blatterstellen1() Dim wksBlatt As Object Dim strNeu As String strNeu = InputBox("Bitte Namen des neuen Arbeitsblattes eingeben:") For Each wksBlatt In ActiveWorkbook.Sheets If wksBlatt.Name = strNeu Then MsgBox "Blattname existiert bereits!", vbOKOnly + vbExclamation, "Blatt hinzufügen" Exit Sub End If Next Set wksBlatt = Sheets.Add(before:=Sheets(1)) wksBlatt.Name = strNeu With wksBlatt.PageSetup .LeftMargin = Application.CentimetersToPoints(1) .RightMargin = Application.CentimetersToPoints(1) End With End Sub

Datei schließen

(Tipp 111) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich per Makro eine Datei schließen?.

Datei schließen ohne zu speichen: ACHTUNG: Änderungen werden nicht berücksichtigt!

Sub DateiSchliessen() Workbooks("MeineDatei.xlsx").Close SaveChanges:=False End Sub

Datei schließen mit speichern:

Sub DateiSchliessen() Workbooks("MeineDatei.xlsx").Close SaveChanges:=True End Sub

In diesem Beispiel werden alle geöffneten Arbeitsmappen geschlossen. Bei Änderungen öffnet Excel den Dialog zum Speichern der Änderungen.

Sub DateiSchliessen() Workbooks.Close End Sub

Blatt in eine andere Mappe kopieren

(Tipp 112) Nachricht zum Beitrag an Autor Nach oben

Auf dem Blatt "Huber" steht in A10 der Pfad und der Name der Datei "Ablage.xls". In diese Datei möchte ich das Blatt "Huber" kopieren. Das Blatt soll in der Datei als letztes erscheinen; diese soll anschließend geschlossen werden.

Eigentlich wäre es mit diesem (sicher selbst erklärendem) Code getan:

Dim strPfad As String, strDatei As String strPfad = ThisWorkbook.Sheets("Huber").Range("A10") strDatei = Dir(strPfad) Workbooks.Open Filename:=strPfad ThisWorkbook.Sheets("Huber").Copy after:=Workbooks(strDatei).Sheets(Sheets.Count) Workbooks(strDatei).Close True

Wenn es da nicht ein paar Fehleranfälligkeiten geben würde:

  • Existiert die Datei überhaupt?
  • Ist die Zieldatei bereits geöffnet?
  • Gibt es in der Zieldatei bereits ein Blatt mit dem Namen?

Wenigstens diese Fragen sollten im Code noch geklärt werden, damit es keine Fehlermeldungen durch Excel und Abbrüche gibt. Anhand der Variablennamen sollte deutlich werden, was im Code passiert:

Sub Blatt_kopieren() Dim strPfad As String, strDatei As String Dim bolOffen As Boolean Dim objMappe As Object, objBlatt As Object strPfad = ThisWorkbook.Sheets("Huber").Range("A10") strDatei = Dir(strPfad) If strDatei = "" Then MsgBox "Datei existiert nicht" Exit Sub End If bolOffen = False For Each objMappe In Workbooks If objMappe.Name = strDatei Then bolOffen = True Exit For End If Next If bolOffen = False Then Workbooks.Open Filename:=strPfad For Each objBlatt In Workbooks(strDatei).Sheets If objBlatt.Name = "Huber" Then MsgBox "In der Zieldatei existiert bereits ein Blatt mit dem Namen 'Huber'.", vbOKOnly + vbExclamation, "Blatt existiert" If bolOffen = False Then Workbooks(strDatei).Close False Exit Sub End If Next ThisWorkbook.Sheets("Huber").Copy after:=Workbooks(strDatei).Sheets(Sheets.Count) Workbooks(strDatei).Close True End Sub

Summe aus A1 von allen Blättern

(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

Daten von mehreren Blättern zusammenfassen

(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

Dialogfeld Speichern unter aufrufen

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

Wie kann ich das Dialogfeld Speichern unter aufrufen?

1. Möglichkeit:

Sub SPU() Dim varPfad varPfad = Application.Dialogs(xlDialogSaveAs).Show("test.xls") Select Case varPfad Case -1 'Gesichert Case 0 'Abgebrochen End Select End Sub

2. Möglichkeit (In A1 steht der Dateiname.):

Sub SPU1() Dim varPfad varPfad = Application.GetSaveAsFilename(Range("A1")) If varPfad = False Then Exit Sub ActiveWorkbook.SaveAs varPfad End Sub

Eine Übersicht zu integrierten Dialogfeldern finden Sie in der Beispieldatei: integrierte_dialogfelder.xlsm

Dialogfeld Datei öffnen aufrufen

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

Wie kann ich das Dialogfeld Datei öffnen aufrufen?

Eine Möglichkeit, hier wird eine gewählte Datei geöffnet:

Sub DOe() Select Case Application.Dialogs(xlDialogOpen).Show("test.xls") Case -1: MsgBox "Geöffnet" Case 0: MsgBox "Abgebrochen" End Select End Sub

Bei dieser Variante wird der Pfad zurückgegeben, der dann noch mit .open geöffnet werden muss:

Sub Oeffnen() Dim varPfad varPfad = Application.GetOpenFilename("Microsoft Excel-Dateien (*.xl*), *.xl*") If varPfad = False Then Exit Sub Workbooks.Open Filename:=varPfad End Sub

Eine Übersicht zu integrierten Dialogfeldern finden Sie in der Beispieldatei: integrierte_dialogfelder.xlsm

Titelleiste von Excel ändern

(Tipp 118) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich die Titelleiste von Excel ändern?

Die Titelleiste der Anwendung kann man ändern mit:

Application.Caption = "So wie Du willst"

Zurücksetzen:

Application.Caption = Empty

Die Titelleiste der Mappe kann man einrichten mit:

ActiveWindow.Caption = "Ich bin ein Fenster."

Anwendung Excel beenden

(Tipp 119) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich per Makro Excel beenden, ohne daß gefragt wird, ob die Änderungen gespeichert werden?

Suggeriert, dass die Datei gespeichert ist (wenn nicht gespeichert werden soll) und beendet Excel ohne nachzufragen:

ThisWorkbook.Saved = True Application.Quit

Speichert erst und beendet Excel:

ThisWorkbook.Save Application.Quit

Ansonsten ist auch eine Schleife möglich, wenn mehrere Mappen offen sind, die gespeichert werden sollen:

Sub AnwendungBeenden() Dim wb As Workbook For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then wb.Close True Next Application.Quit End Sub

Wie zu sehen ist, darf die Mappe mit dem Code bei der Schleife noch nicht geschlossen werden, weil sonst die Routine weg ist und der Rest nicht mehr ausgeführt wird. Die muss also zuletzt dran glauben; ggf. kann auch die noch gespeichert werden.

Speichern ohne Meldung

(Tipp 120) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich beim Vorhandensein einer Mappe eine neue ohne Fehlermeldung unter dem Namen der alten speichern?

Um eine Datei ohne Fehlermeldung zu überschreiben, kann der Code verwendet werden:

Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="g:\Test\Test.xls" Application.DisplayAlerts = True

Ob das ein guter Stil ist, sei jedem selbst überlassen …

Suche über mehrere Blätter

(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.



Integrierte Dialogfelder aufrufen:

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

Tabellenblatt auf mehrere Tabellenblätter aufteilen

(Tipp 551) Nachricht zum Beitrag an Autor Nach oben

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

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.