Microsoft Excel

Herbers Excel/VBA-Archiv

Prüfung in Array? | Herbers Excel-Forum


Betrifft: Prüfung in Array? von: Petra
Geschrieben am: 02.12.2009 09:02:58

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

  

Betrifft: Formeln in Tabelle von: Erich G.
Geschrieben am: 02.12.2009 10:05:59

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)<=1980)+(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


  

Betrifft: AW: Prüfung in Array? von: ransi
Geschrieben am: 02.12.2009 10:24:19

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


  

Betrifft: Prüfung in Array oder Formeln von: Erich G.
Geschrieben am: 02.12.2009 12:03:22

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)<=1980)+(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


  

Betrifft: AW: @Erich,@ransi von: Petra
Geschrieben am: 02.12.2009 14:15:45

Hallo Ihr beiden!
Vielen DANK, klappt alles vorzüglich!

Schönen Tag noch
Petra


Beiträge aus den Excel-Beispielen zum Thema "Prüfung in Array?"