Zeitspanne per VBA filtern
01.10.2007 19:00:44
Nils
Sorry, ich bin einfach nicht schnell genug mit der Umsetzung. Mein letzter Beitrag war schon wieder im Archiv. Das letzte Makro (s.u.) habe ich getestet:
1. Wenn ich mit das Filterkriterium im Debugger ansehe, steht dort eine Zahl (Internes Format für Excel, ich weiß nicht wie man das nennt).
2. Diese wird ich in die Variable für den Filter aufgenommen, schaue ich jedoch nach Durchlaufen des Makros in den Filter, ist dieser leer!
3. Übernehme ich die Zahl auf dem Debugger und füge diese manuell in den benutzerdefinierten Filter, werden nur exakt der eine Satz gefiltert. Das Kriterium >= findet keine Berücksichtigung.
Es ist zum Verzweifeln. Liegt das irgendeiner Exceleinstellung? Wie komme ich hier weiter?
Nachmals Dank und Gruß
Nils
Hi
Hast schon recht mit der Mailadresse. So kann es vermutlich auch nicht weniger werden mit den Spams.
Ich habe eine importierte und als Excel gesicherte Datei hoch geladen. Vielleicht ist das ja hilfreich.
https://www.herber.de/bbs/user/46363.xls
Dank und Gruß
Nils
Hallo Nils,
lass mal dieses makro drüberlaufen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub FilterLast48()
Dim dblMin As Double
Dim lngEnd As Long, lngR As Long
Dim a As Variant
On Error Resume Next
Application.ScreenUpdating = False
With ActiveSheet
If .AutoFilterMode Then .Range("A1").CurrentRegion.AutoFilter
lngEnd = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:M" & lngEnd).NumberFormat = "General"
.Range("IV1") = 1
.Range("IV1").Copy
.Range("A1:M" & lngEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
Application.CutCopyMode = False
a = .Range("A1:A" & lngEnd)
For lngR = 2 To UBound(a, 1)
a(lngR, 1) = CDate(a(lngR, 1))
Next
.Range("A1:A" & lngEnd) = a
.Range("A1:A" & lngEnd).NumberFormat = "dd.mm.yyyy hh:mm"
.Range("IV1").Clear
dblMin = Application.Max(.Range("A1:A" & lngEnd)) - 2
If dblMin =" & dblMin
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Gruß Sepp