AW: Makro über alle Tabellenblätter laufen lassen
25.07.2008 15:16:19
Philipo
Hallo Worti,
das habe ich mir auch schong edacht aber er wiederholt sich dann so oft wie es tabellenblätter gibt und macht die Ausgaben in dem ersten Tabellenblatt in dem ich das Makro starte.
Das problem ist wohl, dass die Angaben nicht wie Du erwähnt hast komplett referenzierbar ist.
Denn die Zeilenmenge ist unterschiedlich von Tabellenblatt zu tabellenblatt und ich suche in meinem makro nach der letzten befüllten zeile und mache dann eine zeile frei und mache sozusagen eine neue titelzeile und bilde AVG, SUM etc.
wenn ich einzeln in die Tabellenblätter gehe und mein Makro über die Tastenkombi ausführe klappt alles wunderbar. Ich will jetzt eben nichgt in jedes Tabellenblatt einzlen gehen.
Vielleicht hilft dir mein code weiter ist bestimmt murks und lässt sich alles auch anderst realisieren aber ich habe es so hinbekommen und es läuft und gibt aus was ich mächte jetzt muss nur nocht die "automation" her :)
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
ActiveSheet.Cells(lastrow + 2, 2).Select
ActiveCell.FormulaR1C1 = "Totaldistance in Km"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Totalconsumption in L"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Standconsumption in L"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Averagespeed in Km/h"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Averageweight in T"
ActiveCell.Offset(0, -4).Select
With ActiveCell
Range(.Offset(0, 0), .Offset(0, 4)).Select
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Columns("E:E").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Dim iRow As Integer, iRowL As Integer, iColL As Integer, iCounter As Integer, Zeilen As Integer
iColL = Cells(1, 256).End(xlToLeft).Column
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
If Rows(iRow).Hidden = False Then
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
iCounter = iCounter + 1
End If
End If
Next iRow
Zeilen = iCounter - 1
Zeilen2 = iCounter - 3
Range("B65536").End(xlUp).Offset(1, 0).Formula = "=sum(B2:B" & Range("B65536").End(xlUp).Row & " _
)/1000"
Range("C65536").End(xlUp).Offset(1, 0).Formula = "=sum(C2:C" & Range("C65536").End(xlUp).Row & " _
)/1000"
Range("D65536").End(xlUp).Offset(1, 0).Formula = "=sum(D2:D" & Range("D65536").End(xlUp).Row & " _
)/1000"
Range("E65536").End(xlUp).Offset(1, 0).Formula = "=(sum(E2:E" & Range("E65536").End(xlUp).Row & _
"))/" & Zeilen & "*3.6"
Range("F65536").End(xlUp).Offset(1, 0).Formula = "=sum(F2:F" & Range("F65536").End(xlUp).Row & " _
)/1000"
ActiveCell.Offset(1, -1).Select
ActiveCell.FormulaR1C1 = "SUM:"
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "AVG:"
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value / Zeilen
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value / Zeilen
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value / Zeilen
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value / Zeilen
End Sub