title image


Smiley Re: Bestimmte Daten aus Datenbank herausfiltern II
Hallo Stoef,



das beigefügte Makro geht davon aus, dass deine Daten in Spalte A ab Zeile 1 stehen.

Es selektiert die fraglichen Daten in die Spalte C ab Zeile 1.



Sub Daten_herausfiltern()



Dim dDatum As Date

Dim iMonat As Integer

Dim iJahr As Integer

Dim iIndx As Long

Dim aVar() As Date

Dim iAnzahl As Integer

Dim lZeile As Long

Dim lZeileC As Long



For iJahr = 1990 To Year(Date)

For iMonat = 1 To 12

dDatum = "01." & iMonat & "." & iJahr

' letzte Tag im Monat

dDatum = DateSerial(Year(dDatum), Month(dDatum) + 1, 0)

For iIndx = 1 To 3

' prüfen ob letzte Tag im Monat Sa/So

If Weekday(dDatum) = 1 Or Weekday(dDatum) = 7 Then

' wenn ja, ein Tag davor

dDatum = DateSerial(Year(dDatum), Month(dDatum) + 1, 0) - iIndx

Else

Exit For

End If

Next iIndx

iAnzahl = iAnzahl + 1

ReDim Preserve aVar(iAnzahl)

aVar(iAnzahl) = dDatum

Next iMonat

Next iJahr



For lZeile = 1 To Range("A65536").End(xlUp).Row

Range("A" & lZeile).Value = Trim(Range("A" & lZeile).Value)

Range("AA" & lZeile).Value = Left(Range("A" & lZeile).Value, _

Len(Range("A" & lZeile).Value) - 10)

Range("AB" & lZeile).Value = CDate(Right(Range("A" & lZeile).Value, 10))

Next lZeile



lZeileC = 1



For lZeile = 1 To Range("AA65536").End(xlUp).Row

For iIndx = 1 To UBound(aVar)

If CDate(Range("AB" & lZeile).Value) = aVar(iIndx) Then

Range("C" & lZeileC).Value = Range("AA" & lZeile).Value & _

" " & Range("AB" & lZeile).Value

lZeileC = lZeileC + 1

Exit For

ElseIf CDate(Range("AB" & lZeile).Value) < aVar(iIndx) Then Exit For

End If

Next iIndx

Next lZeile



Range("AA1:AB" & Range("AA65536").End(xlUp).Row).ClearContents



End Sub



Gruß Peter

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: