Daten in Listbox mit zwei Bedingungen

Private Sub UserForm_Activate()
'Daten aus Tabelle in Listbox einlesen
Dim i As Long, n As Long
Dim Dic As Object, ArrValues, arrList()
Application.ScreenUpdating = False
'Listbox leer machen
Personalien.Clear
'Dictionary initialisieren
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("Jahrestabelle")
i = .Range("D1000").End(xlUp).Row
If i > 4 Then
For i = 5 To i
If .Cells(i + 999, 17).Value = True Then
'hier bräuchte ich eine weitere Abfrage
Dic(.Cells(i, 4).Value) = _
Array(.Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6).Value)
End If
Next i
End If
End With
If Dic.Count Then
ArrValues = Dic.items
ReDim arrList(1 To Dic.Count, 1 To 3)
For i = 1 To Dic.Count
For n = 1 To 3
arrList(i, n) = ArrValues(i - 1)(n - 1)
Next
Next
Personalien.List = arrList
End If
Application.ScreenUpdating = True
End Sub