VlookUp mit mehreren Ergebnissen?
22.04.2013 17:06:19
Jörg
Hallo,
hatte einen lichten Moment und bin ein gutes Stück weiter gekommen.
die erste Abfrage habe ich geschafft^^ (Dank an Google und dieses Forum!)
Zu 1)
Ja mit Spaltentitel hätte ich mir die Arbeit auch leichter gemacht, jetzt habe ich mich an die Buchstaben gewöhnt und komme gut zurecht (wird sich aber bei deiner Überarbeitung in der Zukunft bestimmt rächen)
zu 2)
Wird erledigt Spalte F für Entwurf und G für Version, beides Angaben die erst in der Zukunft relevant werden.
zu 3)
Spalte E dient zur Überprüfung, ob ein Teil in dieser Konstellation schon einmal vorhanden war, Doppelnennungen sind nicht erlaubt. Diese Abfrage steht bereits. Gibt es bei der Eingabe hier Übereinstimmungen muss es sich um einen Entwurf oder eine neue Version handeln.
zu 4)
Das Auslesen und Verarbeiten der Spalte ist inzwischen realisiert, es kann zu jedem Teil 4 verschiedene Zustände geben, die die gleiche Grundnummer erhalten aber einen weiteren Index angehängt bekommen (X, OMD, Fertig, /MCF) mit Vlookup habe ich es geschafft.
Der für mich schwierigste Brocken bleibt die automatische Vergabe der Entwurfs- Versionsnummer bei gleicher Zeichnungsnummer. Mehr als jeweils 10 soll es nicht geben, dann ist eine neue Zeichnungsnummer dran.
Vielen Dank nochmals
Jörg
hier der bis dato entstandene Code, nicht ganz so gut strukturiert wie ich es mir dachte Kommentare muss ich aber noch einpflegen:
Option Explicit
'Fetslegen der modulweiten Variablen
Dim strTeil As String
Dim strXTeil As String
Dim strMaterial As String
Dim strKunde As String
Dim strArtikelnamen As String
Dim strGruppe As String
Dim lngNr As Long
Dim strVersion As String
Dim bytZustand As Byte
Dim strZnr As String
Dim lngZeilen As Long 'Zeilenanzahl in Zeichnungsnummer
Dim lngMax As Long 'höchste vergebene Zeichnungsnummer
Dim strVorhanden As String 'eingegebenes X-Teil
Dim strDa As String 'X-Teil vorhanden?
Dim bolDa As Boolean
Dim a As Byte
Dim myData As DataObject
Dim strWS1 As String 'Materialkomponente
Dim strSuche As String
Dim varVergleich1 As Variant
Dim strXteilbez As Variant
Private Sub UserForm_Initialize()
Dim oList As Object, rngc As Range
Set oList = CreateObject("scripting.dictionary")
With Sheets("Artikelnamen")
For Each rngc In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
If Right(rngc, 1) = "X" Then
oList(oList.Count + 1) = rngc.Value
End If
Next
End With
ComboBox1.List = WorksheetFunction.Transpose(oList.items)
Me.ComboBox2.RowSource = "Material!A2:C101"
Me.ComboBox3.RowSource = "Warenuntergruppe!A2:B101"
Me.ComboBox4.RowSource = "Kundennummer!A2:B340"
'Me.ComboBox5.RowSource = "Zustand!A2:B5"
bytZustand = "0"
lngZeilen = Range("Zeichnungsnummer!A1").End(xlDown).Row
'lngMax = Max(Zeichnungsnummer!A)
lngMax = Application.Max(Sheets("Zeichnungsnummer").Range("D:D"))
'Zeilenzahl in Arbeitsblatt Zeichnungsnummer
lngZeilen = IIf(IsEmpty(Worksheets("Zeichnungsnummer").Cells(Rows.Count, 1)), Worksheets(" _
Zeichnungsnummer").Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
End Sub
Private Sub ComboBox1_click() 'Artikelname
strTeil = (ComboBox1.Value)
End Sub
Private Sub ComboBox2_Click() 'Material
strMaterial = ComboBox2
End Sub
Private Sub ComboBox3_Click() 'Warenuntergruppe
strGruppe = ComboBox3
End Sub
Private Sub ComboBox4_Click() 'Kundennummer
If CheckBox1 = False Then
strKunde = ""
Else
strKunde = ComboBox4
strKunde = "_" & strKunde
End If
End Sub
Private Sub CommandButton1_Click()
If ComboBox2 = "1" Then 'Or "11" Or "12"
strWS1 = "C-"
ElseIf ComboBox2 = "11" Then
strWS1 = "C-"
ElseIf ComboBox2 = "12" Then
strWS1 = "C-"
ElseIf ComboBox2 = "2" Then 'Or "3" Or "15" Or "16" Or "17" Or "18" Or "19"
strWS1 = "CF-"
ElseIf ComboBox2 = "3" Then
strWS1 = "CF-"
ElseIf ComboBox2 = "15" Then
strWS1 = "CF-"
ElseIf ComboBox2 = "16" Then
strWS1 = "CF-"
ElseIf ComboBox2 = "17" Then
strWS1 = "CF-"
ElseIf ComboBox2 = "18" Then
strWS1 = "CF-"
ElseIf ComboBox2 = "19" Then
strWS1 = "CF-"
End If
If ComboBox3 = "" Then
MsgBox "Keine Warengruppen angegeben!"
Exit Sub
End If
strVorhanden = Format(strMaterial, "00") & Format(strGruppe, "00") & strTeil
'Überprüfung ob X-Teil schon vorhanden
Dim rng As Range
Set rng = ThisWorkbook.Worksheets(2).Range("C1:C99999").Find(what:=strVorhanden)
If rng Is Nothing Then
bolDa = False
Else
bolDa = True
End If
If bolDa = False And OptionButton1 = False Then
MsgBox "Kein X-Teil vorhanden!"
OptionButton1 = True
Exit Sub
End If
If bolDa = True And OptionButton1 = True Then
MsgBox "X-Teil schon vorhanden!"
Exit Sub
End If
'OptionButtons Abfragen
If OptionButton1 = True Then
bytZustand = "0"
strArtikelnamen = strWS1 & strTeil
TextBox2 = strArtikelnamen
End If
If OptionButton2 = True Then
bytZustand = "1"
strArtikelnamen = strWS1 & Left(strTeil, Len(strTeil) - 1) & "OMD"
TextBox2 = strArtikelnamen
End If
If OptionButton3 = True Then
bytZustand = "2"
strArtikelnamen = strWS1 & Left(strTeil, Len(strTeil) - 2)
TextBox2 = strArtikelnamen
End If
If OptionButton4 = True Then
bytZustand = "3"
strArtikelnamen = strWS1 & Left(strTeil, Len(strTeil) - 2) & "/MCF"
TextBox2 = strArtikelnamen
End If
If CheckBox1 = False Then
strKunde = ""
End If
If CheckBox3 = False Then
strVersion = ""
End If
If strTeil = "" Then
MsgBox "Kein Artikelname angegeben"
Exit Sub
End If
If OptionButton1 = False Then
strXteilbez = Format(strMaterial, "00") & Format(strGruppe, "00") & strTeil
'MsgBox (strXteilbez)
varVergleich1 = Application.WorksheetFunction.VLookup(strXteilbez, Sheets("Zeichnungsnummer" _
).Range("C1:D" & lngZeilen), 2, False)
lngNr = varVergleich1
Else
lngNr = lngMax + 1
End If
strZnr = Format(strMaterial, "00") & Format(strGruppe, "00") & Format(lngNr, "000000") & _
Format(bytZustand, "0") & Format(strKunde, "00000") & strVersion
TextBox1 = strZnr
'Überprüfung ob Teil schon vorhanden
strVorhanden = Format(strMaterial, "00") & Format(strGruppe, "00") & strArtikelnamen
Dim rng2 As Range
Set rng2 = ThisWorkbook.Worksheets(2).Range("E1:B99999").Find(what:=strVorhanden)
If rng2 Is Nothing Then
a = 1
Else
MsgBox ("Zeichnung schon vorhanden!")
Exit Sub
End If
'strXteilbez = Format(strMaterial, "00") & Format(strGruppe, "00") & strTeil
'Zeichnungsnummer abhängig von x-Teil
'varVergleich1 = WorksheetFunction.VLookup(strXteilbez, Sheets("Zeichnungsnummer").Range("C1: _
D" & lngZeilen), 3, False)
'strVergleich1 = VLookup((Format(strMaterial, "00") & Format(strGruppe, "00") & strTeil)" _
0100C-ABA 14 S X", Sheets("Zeichnungsnummer").Range("C1:D" & lngZeilen), 3, False)
'If OptionButton1 = False Then
' MsgBox (strXteilbez)
' varVergleich1 = Application.WorksheetFunction.VLookup(strXteilbez, Sheets(" _
Zeichnungsnummer").Range("C1:D2"), 2, False)
' lngNr = varVergleich1
'Else
' lngNr = lngMax + 1
'End If
'Werte an Tabelle übergeben
lngZeilen = lngZeilen + 1
Sheets("Zeichnungsnummer").Range("A" & lngZeilen).Value = strZnr
Sheets("Zeichnungsnummer").Range("B" & lngZeilen).Value = strArtikelnamen
Sheets("Zeichnungsnummer").Range("C" & lngZeilen).Value = Format(strMaterial, "00") & Format( _
strGruppe, "00") & strTeil
Sheets("Zeichnungsnummer").Range("D" & lngZeilen).Value = lngNr
Sheets("Zeichnungsnummer").Range("E" & lngZeilen).Value = strVorhanden
'Daten in Zwischenablage
Set myData = New DataObject
myData.SetText strZnr
myData.PutInClipboard
'Variablen löschen
End Sub