AW: Zusammmenfassen und Sortieren
07.04.2007 08:10:00
Erich
Hallo Peter,
probier mal dies (in ein normales Modul):
Option Explicit
Sub Zusammenf_KomGeh()
Dim wsZ As Worksheet, zq As Long, zk As Long, zg As Long, datD As Date
Dim rngF As Range
Set wsZ = Worksheets.Add ' neues Blatt
Union(Columns("B"), Columns("D")).NumberFormat = "hh.MM:ss"
Worksheets("Tabelle1").Activate ' Quellblatt
zq = 1 ' Zeile in Quellblatt
While Not IsEmpty(Cells(zq, 3))
Select Case Cells(zq, 5)
Case "kom"
zk = zk + 1
wsZ.Cells(zk, 1) = datD
wsZ.Cells(zk, 2) = Cells(zq, 1)
wsZ.Cells(zk, 5) = Cells(zq, 3)
Case "geh"
Set rngF = wsZ.Cells.Find(What:=Cells(zq, 3), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If rngF Is Nothing Then Stop ' keine Komm-Zeit gefunden
zg = rngF.Row
If IsEmpty(wsZ.Cells(zg, 3)) Then
wsZ.Cells(zg, 3) = datD
wsZ.Cells(zg, 4) = Cells(zq, 1)
Else
Stop ' Geh-Zeit gab's schon
End If
Case ""
If Cells(zq, 3) "Tageswechsel" Then Stop
If IsDate(Cells(zq, 4)) Then datD = Cells(zq, 4) Else Stop
Case Else ' falscher Eintrag in Spalte E
Stop
End Select
zq = zq + 1
Wend
wsZ.Activate
Columns(5).AutoFit
Cells(1, 1).Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort