Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Daten in Listbox mit zwei Bedingungen
24.11.2013 14:37:19
Werner
Hallo,
mit folgendem Code lese ich Daten aus dem Tabellenblatt("Jahrestabelle") in eine mehrspaltige Listbox ein. Den Cod habe ich von Rudi (Danke nochmals). Mittels ScriptingDictionary wird verhindert, dass doppelte Einträge mehrfach eingelesen werden.
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
An der markierten Stelle im Code bräuchte ich eine weitere Abfrage. Hier sollte geprüft werden, ob (.Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6).Value) im Tabellenblatt("Aufenthaltsverbot") bereits vorhanden ist. Wenn ja dann soll der Datensatz nicht eingelesen werden. Kann mir jemand helfen?
Gruß Werner

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten in Listbox mit zwei Bedingungen
24.11.2013 16:07:05
Franc
Bau eine Suche ein.
Bei dem Code suchen wir den Wert von .Cells(i, 4).Value im Zielblatt.
Wenn der Wert gefunden wird, werden danach die beiden Zellen daneben verglichen.
Wenn es übereinstimmt springt es zu weiter und schreibt nichts ins dic
Habs nicht auspobiert/testen können.
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
'Wert suchen
Set c = Worksheets("Aufenthaltsverbot").UsedRange.Find(.Cells(i, 4).Value, LookIn:= _
xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'Wenn der Wert gefunden wurde vergleichen
If c.Offset(0, 1) = .Cells(i, 5).Value And c.Offset(0, 2) = .Cells(i, 6). _
Value Then GoTo weiter
Set c = Worksheets("Aufenthaltsverbot").UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
'wird es nicht gefunden landet er hier
Dic(.Cells(i, 4).Value) = Array(.Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6) _
.Value)
weiter:
'wird der Wert gefunden springt er zu weiter und trägt nichts ein
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

Anzeige
AW: Daten in Listbox mit zwei Bedingungen
24.11.2013 19:31:52
Werner
Hallo Franc,
habe es gerade eingebaut und funktioniert wunderbar. Danke für die Hilfe.
Gruß Werner

AW: Daten in Listbox mit zwei Bedingungen
24.11.2013 19:49:39
Werner
Hallo Franc,
mir ist gerade noch was eingefallen bei dem du mir vielleicht helfen könntest. Ganz großes Kino wäre, wenn es jetzt noch gehen würde, dass mir Datensätze aus dem Tabellenblatt("Jahrestabelle") nicht eingelesen werden, die älter als 3 Monate (abhängig vom aktuellen Tagesdatum) sind. Das Erfassungsdatum der jeweiligen Datensätze steht in Tabellenblatt("Jahrestabelle").cells(i,8) das Tagesdatum in der gleichen Tabelle in der Zelle A1.
Werner

Anzeige
AW: Daten in Listbox mit zwei Bedingungen
24.11.2013 23:29:08
Franc
jain
Folgendes Problem wofür mir grad keine einfache Lösung einfällt.
DateDif als Formel arbeitet genau aber das gibts nicht als WorksheetFunction für VBA.
Da gibts nur DateDiff (mit 2 f)
Beispiel
Mit der Formel DateDif ergibt die Differenz in Monaten vom 31.10.2013 zum 01.11.2013 0 aber mit dem VBA Teil ergibt das 1.
Mit der Formel würde das erst 1 ergeben, wenn man zum Beispiel vom 01.10.2013 bis zum 01.11.2013 rechnet. (so wie es auch richtig ist)
Deshalb das ganze mit Tagen und 92, weil das fast immer hinkommt. ^^
Bei 2 Monaten mit 30 Tagen und einem mit 31 Tagen würdest du 1 Tag zu viel nehmen und beim Februar noch paar mehr.
Weiß ja nicht wie genau das sein muss. Damit kannst es aber zumindest eingrenzen.
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
If DateDiff("d", .Cells(1, 1), .Cells(i, 8))  firstAddress
End If
'wird es nicht gefunden landet er hier
Dic(.Cells(i, 4).Value) = Array(.Cells(i, 4).Value, .Cells(i, 5).Value, . _
Cells(i, 6).Value)
weiter: 'wird der Wert gefunden springt er zu weiter und trägt nichts ein
End If 'Datumdifferenz
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

Anzeige
AW: Daten in Listbox mit zwei Bedingungen
25.11.2013 20:30:36
Werner
Hallo Franc,
das reicht mir so. Muss nicht so genau sein, ich will nur verhindern dass mir zu alte Daten eingelesen werden. Hast mir weiter geholfen, danke.
Werner

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige