AW: Werte in 2 Dateien suchen und in Userform schreibe
26.08.2018 12:59:17
Nepumuk
Hallo Sabbel,
teste mal:
Private Sub UserForm_Activate()
Dim c, rng, var As Range
Dim sFirst, tFirst, Name As String
Dim i, Max, KdNr, Zahl As Integer
Dim Datum As Date
Dim GNR, geraet, Model, Hersteller, Typ, Auftrag As String
Windows("Test.xls").Activate
Sheets("Eingabe").Select
geraet = Range("GeraeteNr")
' Windows("Geraete.xls").Activate
' With Sheets("geraete").Range("F1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
' Set c = .Find(GNR, LookIn:=xlValues)
' If Not c Is Nothing Then
' c.Select
' ActiveCell.Select
' geraet = Selection.Offset(0, -5)
' Hersteller = Selection.Offset(0, -3)
' Typ = Selection.Offset(0, -2)
' Model = Selection.Offset(0, -1)
' TextBox2 = Hersteller
' TextBox1 = Model & " | " & Typ
'
' GoTo weiter
' End If
' Unload Me
' MsgBox "Diese Seriennummer ist nicht vorhanden."
' Windows("Erfassung.xls").Activate
' Sheets("Eingabe Endkunde").Select
' Exit Sub
' End With
'weiter:
ListBox2.Clear
ListBox1.AddItem
ListBox1.List(i, 0) = "GeräteNr"
ListBox1.List(i, 1) = "| Auft.Nr"
ListBox1.List(i, 2) = "| Kunde"
ListBox1.List(i, 3) = "| Gerät"
ListBox1.List(i, 4) = "| Auft.datum"
ListBox1.List(i, 5) = "| Art"
ListBox1.List(i, 6) = "| Betrag"
Set rng = Workbooks("Inhalte.xls").Worksheets("Daten").Range("D:D") _
.Find(What:=geraet, LookIn:=xlValues, LookAt:=xlPart, After:=Range("D65536"))
If Not rng Is Nothing Then
sFirst = rng.Address
i = 0
ListBox2.AddItem
ListBox2.List(i, 0) = rng
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(0, -3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset(0, -1)
ListBox2.List(i, 5) = "| " & Model
ListBox2.List(i, 6) = "| " & rng.Offset(0, 2)
ListBox2.List(i, 7) = "| " & rng.Offset(0, 108)
ListBox2.List(i, 8) = "| " & rng.Offset(0, 107)
i = i + 1
Do
Set rng = Workbooks("Inhalte.xls").Worksheets("Daten").Range("D:D").FindNext(After:=rng)
If rng.Address = sFirst Then Exit Do
ListBox2.AddItem
ListBox2.List(i, 0) = "" & rng
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(0, -3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset(0, -1)
ListBox2.List(i, 5) = "| " & Model
ListBox2.List(i, 6) = "| " & rng.Offset(0, 2)
ListBox2.List(i, 7) = "| " & rng.Offset(0, 108)
ListBox2.List(i, 8) = "| " & rng.Offset(0, 107)
i = i + 1
Loop
End If
Set rng = Workbooks("Inhalte2.xls").Worksheets("Daten").Range("D:D") _
.Find(What:=geraet, LookIn:=xlValues, LookAt:=xlPart, After:=Range("D65536"))
If Not rng Is Nothing Then
sFirst = rng.Address
i = 0
ListBox2.AddItem
ListBox2.List(i, 0) = rng
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(0, -3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset(0, -1)
ListBox2.List(i, 5) = "| " & Model
ListBox2.List(i, 6) = "| " & rng.Offset(0, 2)
ListBox2.List(i, 7) = "| " & rng.Offset(0, 108)
ListBox2.List(i, 8) = "| " & rng.Offset(0, 107)
i = i + 1
Do
Set rng = Workbooks("Inhalte2.xls").Worksheets("Daten").Range("D:D").FindNext(After:=rng)
If rng.Address = sFirst Then Exit Do
ListBox2.AddItem
ListBox2.List(i, 0) = "" & rng
ListBox2.List(i, 1) = "|"
ListBox2.List(i, 2) = rng.Offset(0, -3)
ListBox2.List(i, 3) = "| "
ListBox2.List(i, 4) = rng.Offset(0, -1)
ListBox2.List(i, 5) = "| " & Model
ListBox2.List(i, 6) = "| " & rng.Offset(0, 2)
ListBox2.List(i, 7) = "| " & rng.Offset(0, 108)
ListBox2.List(i, 8) = "| " & rng.Offset(0, 107)
i = i + 1
Loop
End If
' KdNr = ListBox2.List(0, 4)
' 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
' Name = var.Offset(0, 2)
' ListBox2.AddItem
' ListBox2.List(0, 4) = Name
' Max = ListBox2.ListCount
' Max = Max - 2
' For i = 1 To Max
' KdNr = ListBox2.List(i, 4)
' Set var = Workbooks("Kunden.xls").Worksheets("Kundenstamm").Range("A:A") _
' .Find(What:=KdNr, LookIn:=xlValues, LookAt:=xlPart, After:=Range("A8000"))
' Set var = Workbooks("Kunden.xls").Worksheets("Kundenstamm").Range("A:A").FindNext(After:=var)
' tFirst = var.Address
' KdNr = ListBox2.List(i, 4)
' Name = var.Offset(0, 2)
' ListBox2.AddItem
' ListBox2.List(i, 4) = Name
' Next i
Zahl = ListBox2.ListCount
TextBox3 = i
'End If
If ListBox2.ListCount = 0 Then
Unload Me
Exit Sub
End If
If ListBox2.ListCount = 1 Then
ListBox2.ListIndex = 0
' ListBox2.SelectedIndex = i
'Call cmdMark_Click
End If
End Sub
Gruß
Nepumuk