Fehler bei ReDim

13/10/2010 - 14:46 von Stefan | Report spam
Hallo zusammen,

ich versuche eine Liste von Mail-Adressen auf Gültigkeit zu prüfen,
und dann in verscheidenste Arrays zu speichern.
Arrays lasse ich dynamisch, da ich vorher nicht weiß wieviele EIntràge
in welches Array kommen.

Sub checkMail()

Dim ArrInput As Variant
ArrInput = Sheets("INPUT").Range("A1:A1000")
Dim ArrInvalid() As String
Dim ArrValid() As String
Dim ArrFiltered() As String
Dim ArrFilter As Variant
ArrFilter = Array("unknown")

Dim errorCounterNoAt As Integer
errorCounterNoAt = 0
Dim errorCounterDoubleAt As Integer
errorCounterDoubleAt = 0
Dim foundFiltered As Boolean


Sheets("VALID").Cells.Clear

Application.ScreenUpdating = False

For Each StringInput In ArrInput
If Trim(CStr(StringInput)) <> "" Then
If InStr(CStr(StringInput), "@") = 0 Then
errorCounterNoAt = errorCounterNoAt + 1
On Error GoTo ExceptionHandling1
ReDim Preserve ArrInvalid(UBound(ArrInvalid) + 1)
GoTo NoException1
ExceptionHandling1:
ReDim ArrInvalid(1)
NoException1:
ArrInvalid(UBound(ArrInvalid)) = StringInput
ElseIf InStr(CStr(StringInput), "@") <>
InStrRev(CStr(StringInput), "@") Then
errorCounterDoubleAt = errorCounterDoubleAt + 1
On Error GoTo ExceptionHandling2
ReDim Preserve ArrInvalid(UBound(ArrInvalid) + 1)
GoTo NoException2
ExceptionHandling2:
ReDim ArrInvalid(1)
NoException2:
ArrInvalid(UBound(ArrInvalid)) = StringInput
Else
foundFiltered = False
For Each StringFilter In ArrFilter
If InStr(LCase(CStr(StringInput)),
LCase(StringFilter)) > 0 Then
foundFiltered = True
On Error GoTo ExceptionHandling3
ReDim Preserve ArrFiltered(UBound(ArrFiltered)
+ 1, 2)
GoTo NoException3
ExceptionHandling3:
ReDim ArrFiltered(1, 2)
NoException3:
ArrFiltered(UBound(ArrFiltered), 1) LCase(StringInput)
ArrFiltered(UBound(ArrFiltered), 2) LCase(StringFilter)
Exit For
End If
Next
If foundFiltered = False Then
On Error GoTo ExceptionHandling4
ReDim Preserve ArrValid(UBound(ArrValid) + 1)
GoTo NoException4
ExceptionHandling4:
ReDim ArrValid(1)
NoException4:
ArrValid(UBound(ArrValid)) = StringInput
End If
End If
End If
Next

Sheets("VALID").Activate


For i = (LBound(ArrValid) + 1) To UBound(ArrValid)
Sheets("VALID").Cells(i, 1).Value = ArrValid(i)
Next

Application.ScreenUpdating = True

End Sub



Leider funktioniert ReDim nicht so richtig, beim Erweitern des 2. Arry
bekomme ich die Fehlermeldung: "Laufzeitfehler 9: Index außerhalb des
gültigen Bereichs"
Warum kommt der Fehler? Ich versuch mit Exception-Handling genau diese
Fehler abzufangen, was auch beim 1. Array funktioniert.

Hoffe ihr könnt mir weiterhelfen...ich bin echt schon am verzweifeln!:(
 

Lesen sie die antworten

#1 Andreas Killer
13/10/2010 - 17:47 | Warnen spam
Am 13.10.2010 14:46, schrieb Stefan:

ich versuche eine Liste von Mail-Adressen auf Gültigkeit zu prüfen,
und dann in verscheidenste Arrays zu speichern.


Eine eMail wirklich auf Gültigkeit zu prüfen ist ziemlich kompliziert, Deine Prüfung mit dem @ ist nicht mal der Anfang.

http://www.regular-expressions.info/email.html

Arrays lasse ich dynamisch, da ich vorher nicht weiß wieviele EIntràge
in welches Array kommen.


Ist total kompliziert wie Du das machst und auch unnötig. Mit Collections geht's viel viel einfacher.

BTW, diese Newsgroup ist so gut wie abgeschaltet, einen Ersatz gibt es: de.comp.office-pakete.ms-office.excel

Andreas.

Sub checkMail()
Dim ArrInput As Variant
ArrInput = Sheets("INPUT").Range("A1:A1000")

Dim ArrInvalid As New Collection
Dim ArrValid As New Collection
Dim ArrFiltered As New Collection
Dim StringInput, StringFilter
Dim i As Long

Dim ArrFilter As Variant
ArrFilter = Array("unknown")

Dim foundFiltered As Boolean

Sheets("VALID").Cells.Clear
Application.ScreenUpdating = False

For Each StringInput In ArrInput
If Trim(CStr(StringInput)) <> "" Then
If InStr(CStr(StringInput), "@") = 0 Then
ArrInvalid.Add StringInput
ElseIf InStr(CStr(StringInput), "@") <> InStrRev(CStr(StringInput), "@") Then
ArrInvalid.Add StringInput
Else
foundFiltered = False
For Each StringFilter In ArrFilter
If InStr(1, StringInput, StringFilter, vbTextCompare) > 0 Then
foundFiltered = True
ArrFiltered.Add Array(StringInput, StringFilter)
Exit For
End If
Next
If Not foundFiltered Then
ArrValid.Add StringInput
End If
End If
End If
Next

Sheets("VALID").Activate
For i = 1 To ArrValid.Count
Sheets("VALID").Cells(i, 1) = ArrValid(i)
Next

Application.ScreenUpdating = True
End Sub

Ähnliche fragen