Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Prüfung in Array?

Prüfung in Array?
Petra
Guten Morgen allerseits
mit folgendem Makro prüfe ich eine Spalte (ca. 50.000 Zeilen) auf ein gültiges Datum. Einziges Manko, das Makro läuft lange, da es ja auf ca. 50.000 Zellen zugreifen muß. Gibt es eine Möglichkeit, das ganze in ein Array zu packen und dann abzuarbeiten? Wenn ja, wie?
Sub DatumPrüf()
Dim lz As Long, Akt As String, i As Long, a, b
Akt = ThisWorkbook.Name
DatPR = False
With ActiveSheet
lz = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
a = IsDate(.Cells(i, 4))
If a Then
If IsDate(.Cells(i, 4)) And Year(.Cells(i, 4)) >= 1980 And Year(.Cells(i, 4)) < 2020 Then
Else
.Cells(i, 5) = "Datum kleiner 1980 oder größer 2020"
End If
Else
.Cells(i, 5) = "kein Datum"
End If
Next
If Application.CountA(.Range(.Cells(2, 5), .Cells(lz, 5))) > 0 Then
.Range("E1").AutoFilter Field:=5, Criteria1:="<>"
DatPR = True
End If
Kann mir bitte jemand helfen?
DANKE und einen schönen Tag
Petra

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Formeln in Tabelle
02.12.2009 10:05:59
Erich
Hi Petra,
vielleicht ist das hier schneller:

Option Explicit   ' IMMER ZU EMPFEHLEN
Sub DatumPrüf2()
Dim lngZ As Long
With ActiveSheet
lngZ = .Cells(.Rows.Count, 4).End(xlUp).Row
With .Cells(2, 5).Resize(lngZ - 1)
.Formula = _
"=IF(ISBLANK(D2)+ISERROR(DAY(D2))>0,""kein Datum""," & _
"IF((YEAR(D2)2020)>0," & _
"""Datum kleiner 1980 oder größer 2020"",""""))"
.Formula = .Value
End With
If Application.CountA(.Range(.Cells(2, 5), .Cells(lngZ, 5))) > 0 Then
.Range("E1").AutoFilter Field:=5, Criteria1:=""
End If
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Prüfung in Array?
02.12.2009 10:24:19
ransi
HAllo Petra
Ich habs mal versucht umzusetzen.
Teste mal selber:
Sub DatumPrüf()
Dim lz As Long
Dim I As Long
Dim arr
With ActiveSheet
    lz = .Cells(.Rows.Count, 4).End(xlUp).Row
    arr = .Range("D2:E" & lz)
    For I = 1 To lz - 1
        If IsDate(arr(I, 1)) Then
            Select Case Year(arr(I, 1))
                Case 1980 To 2019
                Case Else:
                    arr(I, 2) = "Datum kleiner 1980 oder größer 2020"
            End Select
            Else:
            arr(I, 2) = "kein Datum"
        End If
    Next
    .Range("D2:E" & lz) = arr
End With
End Sub


ransi
Anzeige
Prüfung in Array oder Formeln
02.12.2009 12:03:22
Erich
Hi Ransi,
so geht es etwa in der halben Zeit:

Sub DatumPrüf4()
Dim lz As Long, I As Long, arrD, arrE() As String
With ActiveSheet
lz = .Cells(.Rows.Count, 4).End(xlUp).Row
arrD = .Range("D2:D" & lz)
ReDim arrE(1 To lz - 1)
For I = 1 To lz - 1
If IsDate(arrD(I, 1)) Then
Select Case Year(arrD(I, 1))
Case 1980 To 2019
Case Else:
arrE(I) = "Datum kleiner 1980 oder größer 2020"
End Select
Else
arrE(I) = "kein Datum"
End If
Next
.Range("E2:E" & lz) = Application.Transpose(arrE)
End With
End Sub
Und wenn die Formeln in Spalte E stehen bleiben können,
ist das noch schneller:

Sub DatumPrüf2()
With ActiveSheet
With .Cells(2, 5).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row - 1)
.Formula = _
"=IF(ISBLANK(D2)+ISERROR(DAY(D2))>0,""kein Datum""," & _
"IF((YEAR(D2)2020)>0," & _
"""Datum kleiner 1980 oder größer 2020"",""""))"
'.Formula = .Value                               ' WENN NÖTIG
End With
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: @Erich,@ransi
02.12.2009 14:15:45
Petra
Hallo Ihr beiden!
Vielen DANK, klappt alles vorzüglich!
Schönen Tag noch
Petra

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige