AW: Auswertung
07.07.2007 00:17:00
fcs
Hallo Christian,
hier der Code für die Tabelle "Deckblatt".
Abhängig von der Auswahl in der Combobox werden die Zeilen, deren Datum in die letzen 1, 3 oder 12 Monate fällt aus dem Gesamtblatt in die 4 Einzelblätter kopiert. Vor dem Kopieren werden die vorhandenen Altdaten in den 4 Blättern gelöscht..
Gruß
Franz
Dim Hauptfilialbereich As String
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
Range("F11").Select
Call DatenTransferieren(ComboBox2.Value)
On Error Resume Next
ActiveWorkbook.Worksheets(Array("Deckblatt", "853", "856", "859", "862", "Sum", _
"Auswertung", "Grafiken")).Select
' ActiveWorkbook.Windows(1).SelectedSheets.PrintOut
ActiveWorkbook.Windows(1).SelectedSheets.PrintPreview
ActiveWorkbook.Worksheets("Deckblatt").Select
End Sub
Private Sub Worksheet_Deactivate()
ComboBox2.Clear
End Sub
Sub DatenTransferieren(strZeitintervall$)
Dim wksStorno As Worksheet, wksZiel As Worksheet
Dim lngZeileStorno&, lngZeileZiel&
Dim HFL_Abt$, StartDatum As Date, EndDatum As Date
Dim arrTabellen, strTabName, i%
Set wksStorno = ActiveWorkbook.Worksheets("Stornos Gesamt")
arrTabellen = Array("853", "856", "859", "862") 'Liste der Zieltabellen
'Altdaten in Zieltabellen löschen
For Each strTabName In arrTabellen
Set wksZiel = ActiveWorkbook.Worksheets(strTabName)
With wksZiel
.Range(.Cells(7, 2), .Cells(35, 6)).ClearContents
.Range(.Cells(7, 8), .Cells(35, 9)).ClearContents
End With
Next
'Periodenauswahl auswerten
Select Case strZeitintervall
Case "Letzter Monat"
StartDatum = DateSerial(Year(Date), Month(Date), 1)
EndDatum = DateSerial(Year(Date), Month(Date) + 1, 0)
Case "Letztes Vierteljahr"
StartDatum = DateSerial(Year(Date), Month(Date) - 2, 1)
EndDatum = DateSerial(Year(Date), Month(Date) + 1, 0)
Case "Letztes Jahr"
StartDatum = DateSerial(Year(Date), Month(Date) - 11, 1)
EndDatum = DateSerial(Year(Date), Month(Date) + 1, 0)
End Select
'Werte übertragen
For lngZeileStorno = 6 To wksStorno.Cells(wksStorno.Rows.Count, 2).End(xlUp).Row
For i = LBound(arrTabellen) To UBound(arrTabellen)
'HFL/Abt mit Tabellennamen vergleichen
If IsNumeric(wksStorno.Cells(lngZeileStorno, 2)) Then
HFL_Abt = Format(wksStorno.Cells(lngZeileStorno, 2), "000")
Else
HFL_Abt = wksStorno.Cells(lngZeileStorno, 2)
End If
If HFL_Abt = arrTabellen(i) Then
'Datum mit Auswertezeitraum vergleichen
If wksStorno.Cells(lngZeileStorno, 4) >= StartDatum And _
wksStorno.Cells(lngZeileStorno, 4)