Excel-Scripte
From NJH-Wiki
Autor
Frank Prößdorf
Sortieren nach einer der Spalten
Wollen wir eine bestimmte Menge von Spalten nach einer dieser Spalten sortieren, so können wir zum Beispiel wie folgt vorgehen. Zunächst selektieren wir die zu sortierende Spaltenmenge:
Columns("A:D").Select
Und dann sortieren wir sie, wobei wir als Sortierkriterium eine bestimmte Spalte angeben:
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Formatieren der Kopfzeile
Um mal ein Beispiel zu zeigen, wie man eine Kopfzeile formatieren könnte:
' Erstelle den Rahmen
Rows(1).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' Erstelle die Farbe
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Hinzufügen eines Buttons in die Excel Menüleiste
Im VBA Editor verändern wir nun "DieseArbeitsmappe", welche als Microsoft Excel Objekt im Makro gespeichert ist. Hier fügen wir zwei Funktionen ein. Die erste Funktion dient dazu, den Button beim Hinzufügen des Makros durch den AddIn-Manager in die Menüleiste zu packen, und die zweite dient dazu ihn aus derselben beim Entfernen des akros ebenfalls zu löschen.
Zum Hinzufügen dient also folgende Funktion:
Private Sub Workbook_AddinInstall()
With Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlButton)
.DescriptionText = "Button1"
.TooltipText = "Button1"
.Caption = "Button1"
.Style = msoButtonCaption
.OnAction = "Button1"
End With
End Sub
Und zum Löschen nutzen wir:
Private Sub Workbook_AddinUninstall()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("Button1").Delete
End Sub
Umwandeln des Zahlenformats
Wir wollen nun einmal das Zahlenformat für einen bestimmten Zellbereich von dem zeitähnlichen Format "02:00" in das Dezimalformat "02,00" umwandeln. Hierzu wollen wir zunächst die Anzahl der Zeilen und Spalten herausbekommen:
' Bestimme die Zeilen und Spaltenzahl zeilenanzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row spaltenanzahl = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Nun bestimmen wir den Bereich, den wir entsprechend formatieren möchten, z.B.:
' Bestimme den zu formatierenden Bereich xwert = "a1" ywert = "a" & zeilenanzahl
Und nun wandeln wir die betroffenen Zellen um:
' Selektiere den Bereich
Range(xwert, ywert).Select
For Each zl In ActiveWindow.RangeSelection
wert = zl.Value
wert = wert * 24 ' um auf dei richtige Entsprechung zu kommen
zl.NumberFormat = "#,##0.00" ' ändere das Nummernformat
zl.Value = wert
Next
Ausrichtung für Zellenbereich ändern
Wollen wir für einen bestimmten Zellenbereich die Ausrichtung der Werte ändern, so nutzen wir folgenden Code:
xwert = "c2"
ywert = "c" & zeilenanzahl
Range(xwert, ywert).Select
With Selection
.HorizontalAlignment = xlRight
End With
Teilstring aus String filtern
Wir wollen nun aus dem Beispielstring: "Uhrzeit: (02:00 - 04:00)" den folgenden Teil rausziehen: "02:00 - 04:00". Hierzu werden wir zunächst nach der Stelle suchen, an der in Zelle (1, 1) das erste Mal eine "0" auftaucht:
start = InStr(Cells(1, 1), "0")
Nun wollen wir das Ende des herauszuziehenden Strings erhalten. Dazu suchen wir nach der schliessenden Klammer.
ende = InStr(Cells(1, 1), ")")
Für den folgenden Befehl brauchen wir nun die Länge des Teilstrings, welche wir durch simple Subtraktion erhalten:
ende = ende - start
Und nun geben wir den Teilstring wieder in die Zelle zurück:
Cells(1, 1) = Mid$(Cells(1, 1), start, ende)
Wenn es darum geht das erste Zeichen weg zu schneiden, wenn es eine bestimmte Bedingung erfüllt ist folgender Code nützlich:
If Left(string, 1) = "0" Then string = Right(string, Len(string) - 1) End If
Mit diesem Beispiel wird die führende 0 in einem String weggeschnitten, wenn sie existiert.
Spalte und Zeile finden, in der ein bestimmtes Wort steckt
Es soll die Tabelle nach einem Wort durchsucht werden. Wird dieses Wort das erste Mal gefunden, wird die Spalte und Zeile, in der es steht, in einer Variablen gespeichert.
Dim FoundCell As Range
With Worksheets(1)
On Error Resume Next
Set FoundCell = .Cells.Find("Wort", LookIn:=xlValues)
If Not FoundCell Is Nothing Then
col1 = CInt(FoundCell.Column)
row1 = CInt(FoundCell.Row)
End If
On Error GoTo 0
End With
Exceldatei durch Buttonklick öffnen
Durch Klick auf einen Button soll eine Exceldatei ausgesucht und danach geöffnet werden können. Dieser Codeblock soll durch Klicken auf den Button ausgeführt werden:
Dim varRetVal As Variant
varRetVal = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel-Dateien (*.xls), *.xls", _
Title:="Exceldatei wählen")
If varRetVal = False Then Exit Sub
On Error Resume Next
Workbooks.Open FileName:=varRetVal
If Err > 0 Then
MsgBox "Exceldatei konnte nicht gefunden oder geöffnet werden.", vbExclamation, "Dateifehler"
Exit Sub
End If
Assoziatives Array
Ein wirkliches assoziatives Array gibt es in Visual Basic ja nicht. Hierfür wurde eine Struktur entwickelt, die sich Dictionary nennt. Dieses kann, mehr oder minder schön, alle Aufgaben eines assoziativen Arrays.
Initialisiert wird das ganze durch die Erstellung eines Objekts:
Dim array
Set array = CreateObject("Scripting.Dictionary")
Einträge werden über Add hinzugefügt und Remove gelöscht. Diese Funktionen werden als Methoden des Objekts aufgerufen:
array.Add key, value array.Remove key
Wenn man auf einen Eintrag zugreifen möchte:
If array.exists(key) Then .Cells(1, 1).Value = array(key) End If
Sollen alle Einträge des Dictionarys aufgelistet werden, so kann das zum Beispiel so aussehen:
keys = array.keys For i = 1 To array.count .Cells(i, 1).Value = keys(i) Next i items = array.items For i = 1 To array.count .Cells(i, 2).Value = items(i) Next i
Fehlerbehandlung
Fehler tauchen leider immer wieder mal auf. Um sie irgendwie abzufangen und besser auswerten zu können, folgt hier ein kleiner ErrorHandler.
Es kann sinnvoll sein, dass eine Funktion zurückgibt ob sie fehlerfrei durchlaufen wurde. Hierzu kann man sie als Boolean deklarieren.
Function funktion(datei As String) As Boolean
Erfolgt bei einer Anweisung ein Fehler, so wollen wir, dass mit der nächsten Anweisung fortgefahren wird:
On Error Resume Next
So bald wir an eine Stelle kommen, bei der ein Fehler auftreten kann, sollten wir diesen abfangen. Das kann zum Beispiel sein, wenn eine Datei geöffnet werden soll. Wenn es also einen Fehler gibt, schicken wir eine Nachricht an den Benutzer, zeigen an, dass die Datei nicht geöffnet wurde und gehen zum Bereich Fehler.
oExl.Workbooks.Open datei If Err > 0 Then MsgBox "Exceldatei konnte nicht gefunden oder geöffnet werden.", vbExclamation, "Dateifehler" Set oExl = Nothing GoTo Fehler End If
So verfahren wir an jeder Stelle, an der ein Fehler auftauchen kann.
Wenn am Ende der Funktion kein Fehler aufgetaucht ist, geben wir wahr zurück und beenden die Funktion:
funktion = True Exit Function
Ist doch ein Fehler aufgetaucht, so haben wir diesen zum Bereich Fehler geschickt. In diesem schließen wir jetzt zum Beispiel die Datei, wenn sie geöffnet sein sollte und geben anschließend falsch als Funktionsergebnis zurück.
Fehler:
If Not oExl Is Nothing Then
oExl.ActiveWorkbook.Close SaveChanges:=False
oExl.Quit
End If
funktion = False
End Function
