Userform2 Fehler in Anzeigebox

[Luschi]

Hallo Martin,

arrTab = .Range(.Cells(7, 1), .Cells(lz, ls)).Value
arrTab = Application.Index(arrTab, Evaluate("row(1:" & UBound(arrTab, 1) & ")"), Array(1, 3, 33, 32, 35, 37, 39, 47))

Mit der 2. Befehlszeile schränkst Du den Spaltenbereich des Arrays 'arrTab' ein auf die angegebenen Spalten ein.
In 'Tabelle1!B4:BJ4' hast Du die Indizes der Spalten doch schon erfaßt, und der Geburtstag hat den Index '36'.
Und genau diese Spalte hast Du im Array eliminiert [ Array(1, 3, 33, 32, 35, 37, 39, 47)].
Für solche Überprüfungen ist das Überwachungsfenster im Vba-Editor sehr gut geeignet:
- Haltepunkt setzen auf dem Befehl:  arrTab = .Range(.Cells(7, 1), .Cells(lz, ls)).Value
- Programm starten und am Haltepunkt unterbricht der Debugger die Fortführung
- F8 Taste drücken (Einzelschritt zum Ausführen dieses Befehls)
- dann Variable 'arrTab' markieren
- und mit gedrückter Maustaste ins Überwachungsfester ziehen
- dann kann man sich den Inhalt der Variablen anschauen
- und mit F8 nächsten Vba-Befehl ausführen
- und sieht das eventuelle Dilemma

Gruß von Luschi
aus klein-Paris

[luna101]

Guten Tag Luschi
Danke für den Typ.
Wie kann ich diesen Fehler beheben?
Gruss Martin

[schauan]

Hallöchen,

- dann Variable 'arrTab' markieren
- und mit gedrückter Maustaste ins Überwachungsfester ziehen

es geht auch über das Lokalfenster. Dort werden Variablen ständig angezeigt.

Ansonsten würde ich mir die Frage stellen, warum Du einem Array 2x Inhalte zuweist, ohne dass dazwischen etwas mit dem Array passiert. Eventuell ist die zweite Zeile nicht ok?

Code:

arrTab = .Range(.Cells(7, 1), .Cells(lz, ls)).Value
arrTab = Application.Index(arrTab, Evaluate("row(1:" & UBound(arrTab, 1) & ")"), Array(1, 3, 33, 32, 35, 37, 39, 47))

[Egon12]

@André,

Code:

arrTab = Application.Index(.Range(.Cells(7, 1), .Cells(lz, ls)).Value, Evaluate("row(1:" & ls & ")"), Array(1, 3, 33, 32, 35, 37, 39, 47))

das würde so seinen Zeck erfüllen.

Zur Fehleranalyse ist es aber besser um in die Arraydaten reinschauen zu können. wenn Application.Index() in einen Fehler läuft.
Dies passiert, wenn Formeln in den Zellen stehen und diese Fehler ausgeben. Bei so viel Zeilen lass ich dann zwecks Fehler finden dies in einer Schleife laufen bis eine Arrayzelle bei IsError()  True ausgibt statt im händisch im Blatt oder im Lokalfenster das Array zu durchsuchen.

Wenn dann dem nichts mehr im Wege steht reicht natürlich diese Zeile.

Martins Problem ist: wie bekomme ich den Listboxinhalt immer gleich, egal wo ich eine Spalte einfüge.
Das ist wiederum auch nicht weiter kompliziert. 

@ Martin,
Tausche den kompletten Code im Userform gegen diesen aus.

Code:

Option Explicit
    Const ZeileNrÜberschrift = 6
    Const UfSpalten = "Wenn blau Portrait öffnen###L.Nr.###Name###Vornamen###Geburts Datum###Hochzeits Datum###Todes Datum###Notizen"
Private Sub CommandButton1_Click()
    Suchen
End Sub
Sub Suchen()
    Dim arrTab(), arrList(), arrSpN, tmp, tmp1$, Spn As Variant, lz&, ls&, j&, k&
    Dim lng As Long
    Dim i   As Long
    Dim str_name As String
    Dim str_vorname As String
    Dim dat_geb As Variant
    Dim str_geb As String
    Dim str_hochzeit As String
    Dim str_tod As String
    Dim dat_hochzeit As Variant
    Dim dat_tod As Variant
    Dim str_bemerkung As String
   
    tmp = Split(UfSpalten, "###")
    For i = LBound(tmp) To UBound(tmp)
        Spn = Application.Match(tmp(i), Tabelle1.Rows(6), 0)
        If Not IsError(Spn) Then
            tmp1 = tmp1 & Spn & "###"
        End If
    Next i
    arrSpN = Split(Left(tmp1, Len(tmp1) - 3), "###")
    str_name = Me.tbName
    str_vorname = Me.tbVorname
    If Me.tbGeburt <> "" Then
        If Not IsDate(Me.tbGeburt) Then
            str_geb = Me.tbGeburt
            dat_geb = 0
        Else
            dat_geb = Me.tbGeburt
        End If
    Else
        dat_geb = 0
    End If
    If Me.tbHochzeit <> "" Then
        If Not IsDate(Me.tbHochzeit) Then
            str_hochzeit = Me.tbHochzeit
            dat_hochzeit = 0
        Else
            dat_hochzeit = Me.tbHochzeit
        End If
    Else
        dat_hochzeit = 0
    End If
    If Me.tbTod <> "" Then
        If Not IsDate(Me.tbTod) Then
            str_tod = Me.tbTod
            dat_tod = 0
        Else
            dat_tod = Me.tbTod
        End If
    Else
        dat_tod = 0
    End If
    str_bemerkung = Me.tbBemerkung
   
    ListBox1.ColumnCount = 9
    ListBox1.ColumnWidths = "10;40;120;120;60;60;80;178;0"
    ListBox1.TextAlign = fmTextAlignLeft
    Debug.Print dat_hochzeit
    With Tabelle1
        .Application.EnableEvents = False
        lz = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        ls = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
        .Application.EnableEvents = True
        arrTab = .Range(.Cells(7, 1), .Cells(lz, ls)).Value
        arrTab = Application.Index(arrTab, Evaluate("row(1:" & UBound(arrTab, 1) & ")"), arrSpN)
        For i = 1 To UBound(arrTab)
            If arrTab(i, 1) & arrTab(i, 2) & arrTab(i, 3) & arrTab(i, 4) & arrTab(i, 5) & arrTab(i, 6) & arrTab(i, 7) & arrTab(i, 8) <> "" Then k = k + 1
        Next i
        ReDim arrList(1 To k, 1 To UBound(arrTab, 2))
        k = 0
        For i = 1 To UBound(arrTab, 1)
            If arrTab(i, 1) & arrTab(i, 2) & arrTab(i, 3) & arrTab(i, 4) & arrTab(i, 5) & arrTab(i, 6) & arrTab(i, 7) & arrTab(i, 8) <> "" Then
                k = k + 1
                For j = 1 To UBound(arrTab, 2)
                    arrList(k, j) = arrTab(i, j)
                Next j
            End If
        Next i
    End With
    i = 0
    ListBox1.Clear
    For lng = 1 To UBound(arrList)
       If (str_name = "" Or InStr(1, arrList(lng, 3), str_name, vbTextCompare) > 0) _
           And (str_vorname = "" Or InStr(1, arrList(lng, 4), str_vorname, vbTextCompare) > 0) _
               And (dat_geb = 0 Or InStr(1, arrList(lng, 5), dat_geb, vbTextCompare) > 0) _
                And (str_geb = "" Or InStr(1, arrList(lng, 5), str_geb, vbTextCompare) > 0) _
                  And (dat_hochzeit = 0 Or InStr(1, arrList(lng, 6), dat_hochzeit, vbTextCompare) > 0) _
                     And (str_hochzeit = "" Or InStr(1, arrList(lng, 6), str_hochzeit, vbTextCompare) > 0) _
                        And (str_bemerkung = "" Or InStr(1, arrList(lng, 8), str_bemerkung, vbTextCompare) > 0) _
                            And (dat_tod = 0 Or InStr(1, arrList(lng, 7), dat_tod, vbTextCompare) > 0) _
                                And (str_tod = "" Or InStr(1, arrList(lng, 7), str_tod, vbTextCompare) > 0) _
        Then
            ' Listbox mit Daten füllen
            With ListBox1
                .AddItem arrList(lng, 1)
                For j = 1 To .ColumnCount - 2
                    .Column(j, i) = arrList(lng, j + 1)
                Next j
                .Column(9, i) = lng + ZeileNrÜberschrift
            End With
            i = i + 1
         End If
    Next lng
       ' Überprüfen, ob keine Einträge gefunden wurden
    If i = 0 Then
        MsgBox "Es wurden keine Einträge gefunden!", vbInformation, "Suchergebnis"
    End If
End Sub
Private Sub CommandButton2_Click()
     ' Sucheinträge löschen
    tbName = ""
    tbVorname = ""
    tbHochzeit = ""
    tbBemerkung = ""
    tbGeburt = ""
    tbTod = ""
    ListBox1.Clear
End Sub
Private Sub CommandButton3_Click()
' Userform beenden
Unload Userform1
End Sub
Private Sub CommandButton4_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    ' Userform 1 beenden und Userform2 öffnen
    Unload Me
    UserForm2.Show
End Sub
Private Sub CommandButton5_Click()
' Markierte Person selektieren und
' in die betreffende Zeile springen
    With Tabelle1
        .Range(.Cells(ListBox1.Column(9), 1), .Cells(ListBox1.Column(9), 46)).Select
    End With
    Unload Me
End Sub
Private Sub ListBox1_Click()
    iZeile = ListBox1.List(ListBox1.ListIndex, 9)
End Sub

In die Konstanze UfSpalten sind Namen der Tabellenspalten mit Trenner ### vorgegeben. Daraus werden die Spaltennummern berechnet, damit es egal ist wo du eine neue Spalte in die Tabelle einfügst. Somit verrutscht in der Listbox nichts mehr und der Filter schießt nicht mehr neben das Ziel.
Im "And Filter" habe ich die unsinnigen Typenumwandlungen rausgenommen. Dafür gibt es das Argument vbTextCompare in der Instr() Funktion.

Gruß Uwe

---

Eine Sache hätte ich noch: 

Wenn klar ist, dass es sich nur um Texteinträge in Zellen handelt, kann man sich auch den Umweg über die Variablen vor dem Filter schenken.
Aber das wäre auch eine Sache für zuletzt.

[schauan]

@Uwe, das

warum Du einem Array 2x Inhalte zuweist, ohne dass dazwischen etwas mit dem Array passiert.

nehme ich schuldbewusst zurück

[Egon12]

@André,

Alles gut. 

Schönes Grill- und biertaugliches Wochenende.

Gruß Uwe

[schauan]

... danke, Uwe, wünsche ich Dir auch

[luna101]

Guten Tag Uwe,
Du hast das Projekt gerettet. Alles funktioniert.
Nochmals   lichen  . für Deine Hilfe.
Gruss und ein schönes Wocheende wünscht Dir
Martin

PS: Es sind alles nur Texteinträge
      mit Ausnahme der Spalte "B".

---

Guten Tag  André
Danke für die Info.
Wünsche noch ein schönes Wocheende
Gruss Martin

[Egon12]

Hallo Martin,

Ich melde mich nochmals wegen Text Datum/Echtes Datum.
In deiner Testdatei gibt es beides schau in Zelle AV7. Das ist ein echtes Datum.

Ich habe jetzt mal noch auf die Schnelle den Filter bereinigt und das Laden der Listbox geändert. 
Teste mal.

Code:

Sub Suchen()
    Dim arrTab(), arrList(), arrSpN, tmp, tmp1$, Spn As Variant, lz&, ls&, j&, k&
    Dim lng As Long
    Dim i   As Long
    Dim str_name As String
    Dim str_vorname As String
    Dim dat_geb As Variant
    Dim str_geb As String
    Dim str_hochzeit As String
    Dim str_tod As String
    Dim dat_hochzeit As Variant
    Dim dat_tod As Variant
    Dim str_bemerkung As String
   
    tmp = Split(UfSpalten, "###")
    For i = LBound(tmp) To UBound(tmp)
        Spn = Application.Match(tmp(i), Tabelle1.Rows(6), 0)
        If Not IsError(Spn) Then
            tmp1 = tmp1 & Spn & "###"
        End If
    Next i
    arrSpN = Split(Left(tmp1, Len(tmp1) - 3), "###")
    str_name = Me.tbName
    str_vorname = Me.tbVorname
    If Me.tbGeburt <> "" Then
        If Not IsDate(Me.tbGeburt) Then
            str_geb = Me.tbGeburt
            dat_geb = 0
        Else
            dat_geb = Me.tbGeburt
        End If
    Else
        dat_geb = 0
    End If
    If Me.tbHochzeit <> "" Then
        If Not IsDate(Me.tbHochzeit) Then
            str_hochzeit = Me.tbHochzeit
            dat_hochzeit = 0
        Else
            dat_hochzeit = Me.tbHochzeit
        End If
    Else
        dat_hochzeit = 0
    End If
    If Me.tbTod <> "" Then
        If Not IsDate(Me.tbTod) Then
            str_tod = Me.tbTod
            dat_tod = 0
        Else
            dat_tod = Me.tbTod
        End If
    Else
        dat_tod = 0
    End If
    str_bemerkung = Me.tbBemerkung
   
    ListBox1.ColumnCount = 9
    ListBox1.ColumnWidths = "10;40;120;120;60;60;80;178;0"
    ListBox1.TextAlign = fmTextAlignLeft
    Debug.Print dat_hochzeit
    With Tabelle1
        .Application.EnableEvents = False
        lz = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        ls = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
        .Application.EnableEvents = True
        arrTab = Application.Index(.Range(.Cells(7, 1), .Cells(lz, ls)), Evaluate("row(1:" & ls & ")"), arrSpN)
    End With
    i = 0
    ReDim arrList(1 To UBound(arrTab), 1 To 10)
    For lng = 1 To UBound(arrTab)
       If (str_name = "" Or InStr(1, arrTab(lng, 3), str_name, vbTextCompare) > 0) _
           And (str_vorname = "" Or InStr(1, arrTab(lng, 4), str_vorname, vbTextCompare) > 0) _
               And (dat_geb = 0 Or InStr(1, arrTab(lng, 5), dat_geb, vbTextCompare) > 0) _
                And (str_geb = "" Or InStr(1, arrTab(lng, 5), str_geb, vbTextCompare) > 0) _
                  And (dat_hochzeit = 0 Or InStr(1, arrTab(lng, 6), dat_hochzeit, vbTextCompare) > 0) _
                     And (str_hochzeit = "" Or InStr(1, arrTab(lng, 6), str_hochzeit, vbTextCompare) > 0) _
                        And (str_bemerkung = "" Or InStr(1, arrTab(lng, 8), str_bemerkung, vbTextCompare) > 0) _
                            And (dat_tod = 0 Or InStr(1, arrTab(lng, 7), dat_tod, vbTextCompare) > 0) _
                                And (str_tod = "" Or InStr(1, arrTab(lng, 7), str_tod, vbTextCompare) > 0) _
        Then
            If arrTab(lng, 2) <> "" Then
                k = k + 1
                For i = 1 To UBound(arrTab, 2)
                    arrList(k, i) = arrTab(lng, i)
                Next i
                arrList(k, 10) = lng + ZeileNrÜberschrift
            End If
         End If
    Next lng
    With ListBox1
        If k > 0 Then
            If k > 1 Then
                .List = Application.Index(arrList, Evaluate("row(1:" & k & ")"), Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))
            Else
                .Column = Application.Index(arrList, Evaluate("row(1:" & k & ")"), Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))
            End If
        Else
            .Clear
        End If
    End With
       ' Überprüfen, ob keine Einträge gefunden wurden
    If i = 0 Then
        MsgBox "Es wurden keine Einträge gefunden!", vbInformation, "Suchergebnis"
    End If
End Sub

Schönes Wochenende

Gruß Uwe

[luna101]

Guten Abend Uwe
Funktioniert perfekt.
Besten Dank für Deine Hilfe.
Wünsche noch ein schönes Wochenende, ein kühles 
Plätzchen und ein kühles Bierchen dazu.
Mit dankbaren Grüssen
Martin