Excel Tricks

Alle Sheets durchlaufen

Sub COR_Summery()

Dim sheetname
On Error Resume Next
sheetname = "Ergebnis"
Sheets(sheetname).Select
Sheets(sheetname).Delete
On Error GoTo 0
Set sumsheet = Sheets.Add
sumsheet.Name = sheetname
sumsheet.Move Before:=Sheets(1)
sumsheet.Range("A1").Value = "Datum"
sumsheet.Range("B1").Value = "Name"
sumsheet.Range("C1").Value = "Strasse"
sumsheet.Range("D1").Value = "Ort"
SumLineCount = 2
For Each ws In Worksheets
sumsheet.Cells(SumLineCount, 1).Value = ws.Cells(14 , 6 )
sumsheet.Cells(SumLineCount, 2).Value = ws.Cells(9 , 1 )
sumsheet.Cells(SumLineCount, 3).Value = ws.Cells(10 , 1 )
sumsheet.Cells(SumLineCount, 4).Value = ws.Cells(11 , 1 )
SumLineCount = SumLineCount + 1
Next ws
MsgBox ("Done!")
End Sub

Zeilenweise durchlaufen (mit Outlook)

Sub OutlookItems()
Dim OutlookApp As Object
Set OutlookApp = CreateObject("Outlook.Application")
Dim Addresses As New Collection
If MsgBox("Do you really want to generate the AVs?", vbYesNo + vbCritical + vbDefaultButton2, "Confirm Distribution") <> vbYes Then
Exit Sub
End If
receivers = "receiver@address.com"
' ActiveWorkbook.Save
i = 3
While Worksheets("items").Cells(i, 1) <> ""
With OutlookApp.CreateItem(olMailItem)
.Body = Worksheets("items").Cells(i, 2)
.Subject = "avc#new " & Worksheets("items").Cells(i, 3) & " " & Worksheets("items").Cells(i, 1)
.To = receivers
.send
End With
i = i + 1
Wend
End Sub

Zeilenweise durchlaufen (mit Ergebnissen auf neuer Seite)

Sub CreatePivotData()
'startingrow
'in which row is the table header
tableHeader = 1
i = tableHeader + 1
'colum with loop criteria
datacolum = 6
'name of sheet to be run through
sourceSheet = "raw"
'name of sheet to store the data onto
targetsheet = "rawPivot"
Dim newSheet As Worksheet
On Error Resume Next
Worksheets(targetsheet).Delete
On Error GoTo 0
Set newSheet = Worksheets.Add()
newSheet.Name = targetsheet
targetcount = 1
While Worksheets(sourceSheet).Cells(i, datacolum) <> ""
' in which colum do the table start?
xPos = 11
While Worksheets(sourceSheet).Cells(tableHeader, xPos) <> ""
If Worksheets(sourceSheet).Cells(i, xPos).Value <> "" Then
newSheet.Cells(targetcount, 1).Value = Worksheets(sourceSheet).Cells(i, datacolum).Value
newSheet.Cells(targetcount, 2).Value = Worksheets(sourceSheet).Cells(tableHeader, xPos).Value
newSheet.Cells(targetcount, 3).Value = Worksheets(sourceSheet).Cells(i, xPos).Value
targetcount = targetcount + 1
End If
xPos = xPos + 1
Wend
i = i + 1
Wend
End Sub

X/Y - Matrix umformen in Listenform

Liegen Daten nur als Matrix vor,

C1	C2	C3
R1	a	b	c
R2	d	e	f
R3	g	h	i

so kann man sie in eine Listenform überführen, indem man einen numerischen Index durch Teiler und Teilerrest in eine Excel- Zellenadressierung umrechnet und sich so per Formel den 1.. ,2.. ,3.. Wert aus der Tabelle holt:

indizierter Zugriff auf den Tabelleninhalt
Index	Reiheninhalt Rx	Reiheninhalt Cx	Tabelleninhalt
1	=INDIRECT(ADDRESS(y_offset+FLOOR($index/tabellenbreite;1);x_offset))	=INDIRECT(ADDRESS(y_offset;x_offset+MOD($index;tabellenbreite)))	=INDIRECT(ADDRESS(y_offset+FLOOR($index/tabellenbreite;1);x_offset+MOD($index;tabellenbreite)))
2	=…	=…	=…
..n	=…	=…	=…

VBA Scripte auslesen

Die unterschiedlichsten Tools bieten die Möglichkeit, enthaltene VBA- Scripte aus Excel-Daten zu extrahieren. Auf Anhieb geklappt hat zum Beispiel olevba von https://github.com/decalage2/oletools/wiki/olevba

olevba excel.xls

schreibt die enthaltenen Scripte in die Standardausgabe