Datum auswerten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub CheckRevenue() dim i as long, LastRow as long, NoRevDay as long, MyRange as Range LastRow=Range("A65536").end(xlup).row NoRevDay=0 For i=1 to lastrow if worksheetfunction.isdate(cells(i,1))=true then 'Myrange setzen fuer Datum (24 zeilen) set myrange=Range(cells(i,1),cells(i+23,1)) if application.count(myrange.offest(0,1))=0 then NoRevDay=NoRevDay + 1 i=i+23 else i=i+23 end if end if next i MsgBox "Kein Umsatz an " & NoRevDay & " Tagen" End Sub

Sub CheckRevenue() Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range LastRow = Range("A65536").End(xlUp).Row NoRevDay = 0 For i = 1 To LastRow If IsDate(Cells(i, 1).Value) = True Then 'Myrange setzen fuer Datum (24 zeilen) Set MyRange = Range(Cells(i, 1), Cells(i + 23, 1)) If Application.CountIf(MyRange.Offset(0, 1), "0") = 0 Then NoRevDay = NoRevDay + 1 i = i + 23 Else i = i + 23 End If End If Next i MsgBox "Kein Umsatz an " & NoRevDay & " Tagen" End Sub

Sub CheckRevenue() Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range, Msg as string LastRow = Range("A65536").End(xlUp).Row NoRevDay = 0 For i = 1 To LastRow If IsDate(Cells(i, 1).Value) = True Then 'Myrange setzen fuer Datum (24 zeilen) Set MyRange = Range(Cells(i, 1), Cells(i + 23, 1)) If Application.CountIf(MyRange.Offset(0, 1), "0") = 0 Then NoRevDay = NoRevDay + 1 Msg=msg & vbcrlf & cstr(Cells(i,1).value) i = i + 23 Else i = i + 23 End If End If Next i MsgBox "Kein Umsatz an " & NoRevDay & " Tagen." & vbcrlf & "Umsatzlose tage: " & vbcrlf & msg End Sub

Sub CheckRevenue() Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range, Msg As String Dim SameDateCnt As Long, DateArr() As Variant LastRow = Range("A65536").End(xlUp).Row NoRevDay = 0 For i = 1 To LastRow If IsDate(Cells(i, 1).Value) = True Then 'Myrange setzen fuer selbes Datum For SameDateCnt = 1 To 26 If Cells(i + SameDateCnt, 1).Value Cells(i, 1).Value Then SameDateCnt = SameDateCnt - 1 Exit For End If Next SameDateCnt Set MyRange = Range(Cells(i, 1), Cells(i + SameDateCnt, 1)) If Application.CountIf(MyRange.Offset(0, 1), "0") = 0 Then NoRevDay = NoRevDay + 1 ReDim Preserve DateArr(NoRevDay) DateArr(NoRevDay) = Cells(i, 1).Value i = i + 23 Else i = i + 23 End If End If Next i Cells(1, 5).Value = "Umsatzlose Tage:" Cells(1, 6).Value = NoRevDay Cells(2, 5).Value = "Kein Umsatz:" For i = LBound(DateArr) To UBound(DateArr) If DateArr(i) "" Then Cells(1 + i, 6) = DateArr(i) End If Next i End Sub

Hallo!
Ja, hatte noch das mit den unterschiedlichen Tagesanzahlen uebersehen.

Sub CheckRevenue()
Dim i As Long, LastRow As Long, NoRevDay As Long, MyRange As Range, Msg As String
Dim SameDateCnt As Long, DateArr() As Variant
LastRow = Range("A65536").End(xlUp).Row
NoRevDay = 0
For i = 1 To LastRow
If IsDate(Cells(i, 1).Value) = True Then
'Myrange setzen fuer selbes Datum
For SameDateCnt = 1 To 26
If Cells(i + SameDateCnt, 1).Value  Cells(i, 1).Value Then
SameDateCnt = SameDateCnt - 1
Exit For
End If
Next SameDateCnt
Set MyRange = Range(Cells(i, 1), Cells(i + SameDateCnt, 1))
If Application.CountIf(MyRange.Offset(0, 1), "0") = 0 Then
NoRevDay = NoRevDay + 1
ReDim Preserve DateArr(NoRevDay)
DateArr(NoRevDay) = Cells(i, 1).Value
i = i + SameDateCnt
Else
i = i + SameDateCnt
End If
End If
Next i
Cells(1, 5).Value = "Umsatzlose Tage:"
Cells(1, 6).Value = NoRevDay
Cells(2, 5).Value = "Kein Umsatz:"
For i = LBound(DateArr) To UBound(DateArr)
If DateArr(i)  "" Then
Cells(1 + i, 6) = DateArr(i)
End If
Next i
End Sub

Gruss
Dirk aus Dubai

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread