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