Re: ListBox
24.04.2003 15:15:02
Bertram
Hallo Stefan,ich versteh dein Problem nicht ganz, ein bischen mehr Code wäre nicht schlecht.
Hier mal eine Prozedur die bei mir eingebaut ist. Vielleicht hilft sie dir weiter. Bei Fragen einfach posten.
Sub KundennamenSuchen(Name As String)
'Kundenname suchen
Dim Kundenmatrix() As String
Dim Bereich As Range
Dim i As Integer
Dim j As Integer
Dim intZelleAlt As Integer
Dim intZelleNeu As Integeri = Sheets("Kunden").Range("D1").Value
j = 0
'Kundenmatrix dimensionieren
ReDim Kundenmatrix(3, i)
'Kundenmatrix füllen
Application.ScreenUpdating = False
With Sheets("Kunden")
.Visible = True
.Activate
Set Bereich = .Range("B1:B" & Range("D1").Value)
On Error Goto Fehler
Bereich.Find(What:=Name, LookAt:=xlPart).Activate
Kundenmatrix(0, 0) = Range("A" & Mid(ActiveCell.Address(False, False), 2)).Value
Kundenmatrix(1, 0) = Range("B" & Mid(ActiveCell.Address(False, False), 2)).Value
Kundenmatrix(2, 0) = Range("C" & Mid(ActiveCell.Address(False, False), 2)).Value
intZelleAlt = Mid(ActiveCell.Address(False, False), 2)
Do
Bereich.FindNext(After:=ActiveCell).Activate
intZelleNeu = Mid(ActiveCell.Address(False, False), 2)
If intZelleNeu <= intZelleAlt Then Exit Do
j = j + 1
Kundenmatrix(0, j) = Range("A" & Mid(ActiveCell.Address(False, False), 2)).Value
Kundenmatrix(1, j) = Range("B" & Mid(ActiveCell.Address(False, False), 2)).Value
Kundenmatrix(2, j) = Range("C" & Mid(ActiveCell.Address(False, False), 2)).Value
intZelleAlt = intZelleNeu
Loop
.Visible = xlVeryHidden
End With
Application.ScreenUpdating = True
ReDim Preserve Kundenmatrix(3, j)
Customers.lboCustomers.ColumnWidths = "1,5cm;7cm;6cm"
Customers.lboCustomers.Column() = Kundenmatrix
Exit Sub
Fehler:
Customers.lboCustomers.Clear
Sheets("Kunden").Visible = xlVeryHidden
Exit Sub
End Sub
Code eingefügt mit Syntaxhighlighter 1.14
Gruß
Bertram