14 fertige Excel-Makros

Share this post on:

In diesem Unterricht werden wir Ihnen vorzeigen wie Sie schnell und einfach die Programmiersprache VBA (Visual Basic für Aplikationen) verwenden können, wodurch Sie die Möglichkeiten von Excel und Microsoft Office nach Ihren konkreten Bedürfnissen erweitern zugleich Ihre Effektivität beim Umgang mit der Software spürbar verbessern könnten. Sie brauchen keine Erfahrung mit der Programmierung, um sich von der Information in diesem Artikel zu begünstigen, jedoch sind Grundkentnisse für Excel von Ihnen erwartet. Für Beginner empfehlen wir den nachfolgenden Artikel zunächst durchzulesen: ‚11 Excel-Formeln, die Sie jetzt verwenden müssen‘, um die Grundfunktionen von Excel kennenzulernen.

Wir haben für Sie einige fertige Excel-Makros mit rieseger Funktionsfähigkeit vorbereitet, die Ihnen zur Verfügung gestellt sind, damit Sie Ihre Arbeit besser machen. Um diese nutzbar zu machen, sollen Sie die Makros in Ihrer Excel-Datei installieren. Der nächste Abschnitt informiert den Leser wie das Makro installiert werden kann. Bitte überspringen Sie das nächste Teil, wenn Sie schon wissen, wie es zu machen ist.

Wie installiert man ein Makro?

Drücken Sie in Excel die Tastenkombination alt + F11. Dadurch gelangen Sie in den Excel-VBA-Editor. Klicken Sie dann auf der linken Seite mit der rechten Maustaste auf den Ordner Microsoft Excel Objects und wählen Sie Einfügen => Modul. Hier werden die Makros platziert. Um die Excel-Datei makrofähig zu machen, müssen Sie sie als solche speichern. Wählen Sie auf der Registerkarte Datei => Speichern unter die Option Als makroaktivierte Arbeitsmappe speichern (mit der Erweiterung .xlsm).

  1. Daten von einer Datei in eine andere kopieren

Dieses Makro ist sehr nützlich, da es zeigt, wie Sie einen Datenbereich in VBA kopieren können und wie Sie neue Excel-Dateien (Arbeitsmappen) erstellen und benennen können. Sie können es nach Ihren Bedürfnissen ausbauen:

Sub CopyFiletoAnotherWorkbook() 'Copy the data Sheets("Example 1").Range("B4:C15").Copy 'Create a new workbook Workbooks.Add 'Paste the data ActiveSheet.Paste 'Turn off application alerts Application.DisplayAlerts = False 'Save the newly file. Change the name of the directory. ActiveWorkbook.SaveAs Filename:="C:\Temp\MyNewBook.xlsx" 'Turn application alerts back on Application.DisplayAlerts = True End Sub
  1. Ausgeblendete Zeilen anzeigen

Manchmal enthalten die Excel-Dateien verdeckte Zeilen, um sie besser sichtbar zu machen. Hier ist ein Makro, das alle Zeilen im aktiven Blatt anzeigt:

Sub ShowHiddenRows() Columns.EntireColumn.Hidden = False Rows.EntireRow.Hidden = False End Sub
  1. Leere Zeilen und Spalten löschen

Leere Zeilen in Excel sind ein Problem bei der Datenverarbeitung. Hier erfahren Sie, wie Sie sie loswerden können!

Sub DeleteEmptyRowsAndColumns() 'Declare your variables. Dim MyRange As Range Dim iCounter As Long 'Define the target Range. Set MyRange = ActiveSheet.UsedRange 'Start reverse looping through the range of Rows. For iCounter = MyRange.Rows.Count To 1 Step -1 'If entire row is empty then delete it. If Application.CountA(Rows(iCounter).EntireRow) = 0 Then Rows(iCounter).Delete 'Remove comment to See which are the empty rows 'MsgBox "row " & iCounter & " is empty" End If 'Increment the counter down Next iCounter 'Step 6: Start reverse looping through the range of Columns. For iCounter = MyRange.Columns.Count To 1 Step -1 'Step 7: If entire column is empty then delete it. If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then Columns(iCounter).Delete End If 'Step 8: Increment the counter down Next iCounter End Sub
  1. Leer Zeile auffinden

Sub FindEmptyCell() ActiveCell.Offset(1, 0).Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop End Sub
  1. Zahlen sortieren

Das folgende Makro sortiert Zahlen aus einer Spalte in aufsteigender Reihenfolge auf Doppelklick. Platzieren Sie es in Blatt 1, nicht in einem Modul, damit es funktioniert:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Declare your Variables Dim LastRow As Long 'Find last row LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Sort ascending on double-clicked column Rows("6:" & LastRow).Sort _ Key1:=Cells(6, ActiveCell.Column), _ Order1:=xlAscending End Sub
  1. Leerzeichen entfernen

Manchmal enthalten Excel-Daten zusätzliche Leerzeichen, die bei der Datenanalyse und der Verwendung von Formeln stören können. Hier ist ein Makro, das alle Leerzeichen zwischen den Daten entfernt, die mit der Maus vorausgewählt werden:

Sub TrimTheSpaces() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Save the Workbook before changing cells Select Case MsgBox("Can't Undo this action. " & _ "Save Workbook First?", vbYesNoCancel) Case Is = vbYes ThisWorkbook.Save Case Is = vbCancel Exit Sub End Select 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Trim the Spaces. If Not IsEmpty(MyCell) Then MyCell = Trim(MyCell) End If 'Get the next cell in the range Next MyCell End Sub
  1. Ersetzen Sie leere Zellen in mehreren Spalten durch einen Wert.

Wie bereits erwähnt, stören leere Zellen die Datenverarbeitung und die Erstellung von Pivot-Tabellen. Hier ist der Code zum Ersetzen leerer Werte durch 0. Dieses Makro hat einen sehr großen Anwendungsbereich, da Sie auf ähnliche Weise N/A-Ergebnisse entfernen sowie andere Zeichen wie Punkte, Kommas, Doppelpunkte usw. finden und ersetzen können.

Sub FindAndReplace() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Save the Workbook before changing cells? Select Case MsgBox("Can't Undo this action. " & _ "Save Workbook First?", vbYesNoCancel) Case Is = vbYes ThisWorkbook.Save Case Is = vbCancel Exit Sub End Select 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Check for zero length then add 0. If Len(MyCell.Value) = 0 Then MyCell = 0 End If 'Get the next cell in the range Next MyCell End Sub
  1. Wiederholte Werte aus mehreren Spalten einfärben

Manchmal gibt es doppelte Werte in mehreren Spalten, die wir hervorheben möchten. Hier ist ein Makro, das genau das tut:

Sub HighlightDuplicates() 'Declare your variables Dim MyRange As Range Dim MyCell As Range 'Define the target Range. Set MyRange = Selection 'Start looping through the range. For Each MyCell In MyRange 'Ensure the cell has Text formatting. If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then MyCell.Interior.ColorIndex = 36 End If 'Get the next cell in the range Next MyCell End Sub
  1. Pivot-Tabelle erstellen

Das Makro kann zur Erstellung von Pivot-Tabellen verwendet werden. Dies ist besonders nützlich, wenn Sie häufig dieselbe Art von Pivot-Tabellen erstellen. Mit einer kleinen Erweiterung kann man den gesamten Prozess der Erstellung von Pivot-Tabellen automatisieren.

Sub PivotTableForExcel2007() Dim SourceRange As Range Set SourceRange = Sheets("Sheet1").Range("A3:N86") ActiveWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=SourceRange, _ Version:=xlPivotTableVersion12).CreatePivotTable _ TableDestination:="", _ TableName:="", _ DefaultVersion:=xlPivotTableVersion12 End Sub
  1. Automatisches Senden einer E-Mail mit einem Excel-Anhang

Mein Lieblingsmakro. Ermöglicht das Anhängen und Versenden der Datei, mit der Sie gerade arbeiten, an eine vordefinierte E-Mail-Adresse, einen Nachrichtentitel und einen Vorlagentext!

Sub SendFIleAsAttachment() 'Declare your variables 'Set reference to Microsoft Outlook Object library Dim OLApp As Outlook.Application Dim OLMail As Object 'Open Outlook start a new mail item Set OLApp = New Outlook.Application Set OLMail = OLApp.CreateItem(0) OLApp.Session.Logon 'Build your mail item and send With OLMail .To = "[email protected]; [email protected]" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add ActiveWorkbook.FullName .Display 'Change to .Send to send without reviewing End With 'Memory cleanup Set OLMail = Nothing Set OLApp = Nothing End Sub
  1. Senden aller Excel-Diagramme aus einer Datei an eine PowerPoint-Präsentation

Sub SendExcelFiguresToPowerPoint() 'Set reference to Microsoft Powerpoint Object Library 'Declare your variables Dim PP As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Dim i As Integer 'Check for charts; exit if no charts exist Sheets("Slide Data").Select If ActiveSheet.ChartObjects.Count < 1 Then MsgBox "No charts existing the active sheet" Exit Sub End If 'Open PowerPoint and create new presentation Set PP = New PowerPoint.Application Set PPPres = PP.Presentations.Add PP.Visible = True 'Start the loop based on chart count For i = 1 To ActiveSheet.ChartObjects.Count 'Copy the chart as a picture ActiveSheet.ChartObjects(i).Chart.CopyPicture _ Size:=xlScreen, Format:=xlPicture Application.Wait (Now + TimeValue("0:00:1")) 'Count slides and add new slide as next available slide number ppSlideCount = PPPres.Slides.Count Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank) PPSlide.Select 'Paste the picture and adjust its position; Go to next chart PPSlide.Shapes.Paste.Select PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True Next i 'Memory Cleanup Set PPSlide = Nothing Set PPPres = Nothing Set PP = Nothing End Sub
  1. Excel-Tabelle in Word senden

Sub ExcelTableInWord() 'Set reference to Microsoft Word Object library 'Declare your variables Dim MyRange As Excel.Range Dim wd As Word.Application Dim wdDoc As Word.Document Dim WdRange As Word.Range 'Copy the defined range Sheets("Revenue Table").Range("B4:F10").Cop 'Open the target Word document Set wd = New Word.Application Set wdDoc = wd.Documents.Open _ (ThisWorkbook.Path & "\" & "PasteTable.docx") wd.Visible = True 'Set focus on the target bookmark Set WdRange = wdDoc.Bookmarks("DataTableHere").Rangе 'Delete the old table and paste new On Error Resume Next WdRange.Tables(1).Delete WdRange.Paste 'paste in the table 'Adjust column widths WdRange.Tables(1).Columns.SetWidth _ (MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth 'Reinsert the bookmark wdDoc.Bookmarks.Add "DataTableHere", WdRange 'Memory cleanup Set wd = Nothing Set wdDoc = Nothing Set WdRange = Nothing End Sub
  1. Extrahieren eines einzelnen Wortes aus dem Text in einer Zelle

Wir können Formeln verwenden, wenn wir eine bestimmte Anzahl von Zeichen extrahieren wollen. Was aber, wenn wir nur das zweite Wort oder die zweite Zahl aus einem Text mit Wörtern und Zeichen in einer Zelle extrahieren wollen? Hierfür können wir mit VBA unsere eigene Funktion erstellen. Lassen Sie uns zwei Funktionen erstellen: findword und findwordrev. Hier ist der Code in VBA:

Function FindWord(Source As String, Position As Integer) As String On Error Resume Next FindWord = Split(WorksheetFunction.Trim(Source), " ")(Position - 1) On Error GoTo 0 End Function Function FindWordRev(Source As String, Position As Integer) As String Dim Arr() As String Arr = VBA.Split(WorksheetFunction.Trim(Source), " ") On Error Resume Next FindWordRev = Arr(UBound(Arr) - Position + 1) On Error GoTo 0 End Function

Wir haben gerade zwei neue Funktionen in Excel erstellt. Die Funktion =FindWordRev(A1,1) ermittelt das letzte Wort aus Zelle A1. Die Funktion =FindWord(A1,3) ermittelt das dritte Wort aus Zelle A1 und so weiter.

  1. Verbot zur Textänderung in der Excel-Datei

Manchmal möchten wir die Daten in der Datei schützen, damit nur wir sie ändern können. Hier sehen Sie, wie man das mit VBA machen kann:

Sub ProtectSheets() 'Declare your variables Dim ws As Worksheet 'Start looping through all worksheets For Each ws In ActiveWorkbook.Worksheets 'Protect and loop to next worksheet ws.Protect Password:="1234" Next ws End Sub

Leave a Comment