Beim Wandeln von Nr in Name wird Leerzeile erzeugt
05.05.2019 18:57:38
Nr
Ich weiß dass man Beispieldateien hochladen soll.
Aber da diese nicht mit Inhalten gefüllt werden müssen frage ich zuerst mal ob jemand anhand des Quellcode den Fehler finden kann.
Und zwar wird die Combobox mit Inhalten gefüllt. Da die Kundendaten in einer anderen Datei liegen werden im Nachgang die Kundennummern durch den Namen ersetzt.
Aber dabei wird für jede Änderung von Kundennummer in Name eine zusätzliche leere Zeile in der Liste eingefügt.
Hat jemand eine Idee woran es liegen kann?
Wenn ich ziemlich unten ListBox2.AddItem auskommentiert werden keine Leerzeilen eingefügt, es erscheint aber ein Laufzeitfehler 381
Vielen Dank im Voraus
Tobi
Private Sub UserForm_Activate()
Dim c, rng, var As Range
Dim sFirst, tFirst, Name, Vorname As String
Dim z, i, Max, KdNr, Zahl As Integer
Dim Datum As Date
Dim GNR, geraet, Model, Hersteller, Typ, Auftrag As String
GNR = Range("Geraetenr")
ListBox2.Clear
ListBox1.AddItem
ListBox1.List(i, 0) = "Auftragsnummer"
ListBox1.List(i, 1) = "| Name"
ListBox1.List(i, 2) = "| Seriennummer"
Set rng = Workbooks("Auftrag.xls").Worksheets("Daten").Range("R:CS") _
.Find(what:=GNR, LookIn:=xlValues, lookat:=xlPart, After:=Range("CS65536"))
If Not rng Is Nothing Then
sFirst = rng.Address
i = 0
ListBox2.AddItem
ListBox2.List(i, 0) = rng.Offset(, -rng.Column + 1)
ListBox2.List(i, 1) = "| "
ListBox2.List(i, 2) = rng.Offset(, -rng.Column + 3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset
i = i + 1
Do
Set rng = Workbooks("Auftrag.xls").Worksheets("Daten").Range("R:CS").FindNext(After:= _
rng)
If rng.Address = sFirst Then Exit Do
ListBox2.AddItem
ListBox2.List(i, 0) = rng.Offset(, -rng.Column + 1)
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(, -rng.Column + 3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng
i = i + 1
Loop
End If
Set rng = Workbooks("Archiv.xls").Worksheets("Daten").Range("R:CS") _
.Find(what:=GNR, LookIn:=xlValues, lookat:=xlPart, After:=Range("CS65536"))
If Not rng Is Nothing Then
sFirst = rng.Address
'i = 0
ListBox2.AddItem
ListBox2.List(i, 0) = rng.Offset(, -rng.Column + 1)
ListBox2.List(i, 1) = "| "
ListBox2.List(i, 2) = rng.Offset(, -rng.Column + 3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset
i = i + 1
Do
Set rng = Workbooks("Archiv.xls").Worksheets("Daten").Range("R:CS").FindNext(After:=rng) _
If rng.Address = sFirst Then Exit Do
ListBox2.AddItem
ListBox2.List(i, 0) = rng.Offset(, -rng.Column + 1)
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(, -rng.Column + 3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng
i = i + 1
Loop
' Kundennummer wird durch Name ersetzt
Zahl = ListBox2.ListCount
KdNr = ListBox2.List(0, 2)
Auftrag = ListBox2.List(0, 2)
Set var = Workbooks("Kunden.xls").Worksheets("Kundenstamm").Range("A:A") _
.Find(what:=KdNr, LookIn:=xlValues, lookat:=xlPart, After:=Range("A8000"))
If Not var Is Nothing Then
tFirst = var.Address
Vorname = var.Offset(0, 3)
Name = var.Offset(0, 2)
If Vorname > " " Then
Name = Vorname & " " & Name
End If
ListBox2.AddItem
ListBox2.List(0, 2) = Name
Max = ListBox2.ListCount
' Max = Max - 2
For z = 1 To Max
KdNr = ListBox2.List(z, 2)
Set var = Workbooks("Kunden.xls").Worksheets("Kundenstamm").Range("A:A") _
.Find(what:=KdNr, LookIn:=xlValues, lookat:=xlPart, After:=Range("A8000"))
tFirst = var.Address
KdNr = ListBox2.List(z, 2)
Vorname = var.Offset(0, 3)
Name = var.Offset(0, 2)
If Vorname > " " Then
Name = Vorname & " " & Name
End If
' Wenn man ListBox2.AddItem auskommentiert werden keine Zeilen eingefügt, es _
erscheint aber eine Fehlermeldung
ListBox2.AddItem
ListBox2.List(z, 2) = Name
Next z
End If
End If
If ListBox2.ListCount = 0 Then
Unload Me
Exit Sub
End If
End Sub