AW: Noch offen
30.11.2003 10:53:00
Nepumuk
Hallo Reinhard,
dann besser mit Arrys arbeiten. Diese Vorgehensweise ist wesentlich schneller als Zell- und Listboxeinträge zu vergleichen.
Mein Vorschlag:
Option Explicit
Private Sub UserForm_Activate()
Dim strArray1() As String, strArray2() As String, varArray() As Variant
Dim lngZeile As Long, intSpalte As Integer, bolgefunden As Boolean
Dim lngDoppelt As Long, lngArrayzeile As Long, strZwischenspeicher() As String
ReDim strZwischenspeicher(0)
varArray = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 3))
'Keine doppelten Nummern
For lngZeile = 1 To UBound(varArray)
For lngArrayzeile = 1 To UBound(strZwischenspeicher)
If varArray(lngZeile, 1) = strZwischenspeicher(lngArrayzeile) Then bolgefunden = True: Exit For
Next
If Not bolgefunden Then
lngDoppelt = lngDoppelt + 1
ReDim Preserve strZwischenspeicher(0 To lngDoppelt)
strZwischenspeicher(lngDoppelt) = varArray(lngZeile, 1)
Else
bolgefunden = False
End If
Next
ReDim strArray1(1 To lngDoppelt, 1 To 3)
lngDoppelt = 0
ReDim strZwischenspeicher(0)
For lngZeile = 1 To UBound(varArray)
For lngArrayzeile = 1 To UBound(strZwischenspeicher)
If varArray(lngZeile, 1) = strZwischenspeicher(lngArrayzeile) Then bolgefunden = True: Exit For
Next
If Not bolgefunden Then
lngDoppelt = lngDoppelt + 1
ReDim Preserve strZwischenspeicher(0 To lngDoppelt)
strZwischenspeicher(lngDoppelt) = varArray(lngZeile, 1)
For intSpalte = 1 To 3
strArray1(lngDoppelt, intSpalte) = varArray(lngZeile, intSpalte)
Next
Else
bolgefunden = False
End If
Next
'Doppelte Namen
lngDoppelt = 0
For lngZeile = 1 To UBound(varArray)
For lngArrayzeile = 1 To UBound(varArray)
If varArray(lngZeile, 2) = varArray(lngArrayzeile, 2) And lngZeile <> lngArrayzeile Then lngDoppelt = lngDoppelt + 1: Exit For
Next
Next
ReDim strArray2(1 To lngDoppelt, 1 To 3)
lngDoppelt = 0
For lngZeile = 1 To UBound(varArray)
For lngArrayzeile = 1 To UBound(varArray)
If varArray(lngZeile, 2) = varArray(lngArrayzeile, 2) And lngZeile <> lngArrayzeile Then
lngDoppelt = lngDoppelt + 1
For intSpalte = 1 To 3
strArray2(lngDoppelt, intSpalte) = varArray(lngZeile, intSpalte)
Next
Exit For
End If
Next
Next
ListBox1.List = CVar(strArray1)
ListBox2.List = CVar(strArray2)
End Sub
Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk