Mehrfach Kriteriensuche

[ChrisKay86]

Hallo Zusammen,
 
ich habe mit einer kleinen Excel-Vorstellung ein paar Probleme. In meiner Arbeitsmappe habe ich ein Arbeitsblatt namens "Lagerbestand", hier sind bis zu 500 Artikel drin die sich wie folgt unterscheiden:
 
Modell (es gibt nur zwei M1 und M2)
Rahmengröße (S, M, L)
Zustand (storing, mounted und delivered)
 
alle weiteren Angaben sind für die Anwendung erstmal irrelevant. Jetzt kommen wir zu meinem Arbeitsblatt "Montagebericht". Hier kann ich über eine UserForm folgende Eintragung vornehmen:
 
Modell wird in Zelle B1 eingetragen
Rahmennummer splittet sich auf mehrere Spalten auf, wichtig hier die Größe in Zeile E3 (ich führe die Rahmennummer mit Hilfe der Textkette in Zelle B4 wieder zusammen)
Systemnummer in B5
 
alle weiteren Angaben sind irrelevant.
 
Jetzt zum eigentlichen Problem bzw. Aufgabe. Nachdem ich den Montagebericht ausgefüllt habe, muss ich ja das Teil aus meinem Lagerbestand von storing auf mounted buchen. Hierfür muss ich nur Modellvariante (M1 oder M2), die Rahmengröße (S,M,L) und den Zustand (storing) abgleichen. Sobald ich in der Liste den ersten Artikel, der allen drei Kriterien gerecht wird, gefunden habe soll die Rahmennummer in Spalte G (sollte leer sein), die Systemnummer in Spalte H (sollte auch leer sein) aus dem Montagebericht kopiert und der Zustand von "storing" auf "mounted" geändert werden. Beide Nummern werden immer erst bei der Montage physisch sichtbar und befinden sich in keiner Tabelle. Ich habe es schon versucht mit VBA LOOKUP was auf die Reihe zu bekommen, aber ich komme gerade absolut nicht weiter und weiß auch nicht woran es hängt. Im Anhang findet ihr die Arbeitsmappe, wo ich auch nochmal Kommentare in die jeweiligen Zellen geschrieben habe.
 
Ich wäre euch so unglaublich dankbar, wenn ihr mir helfen könntet.

  Bestand_Muster.xlsm (Größe: 168,02 KB / Downloads: 10)
 
Beste Grüße
 
Chris

[Flotter Feger]

Hallo Chris,

schön, dass du den Weg hier her gefunden hast.  :32:

Ich vermisse deine Musterdatei ... hast du nur Probleme beim Hochladen, oder möchtest du keine Datei hochladen ?:21:

Die Datei herauszusuchen und aufzurufen reicht hier nicht, du musst auch über "Attachement hinzufügen" auf der rechten Seite, die Datei freigeben.

[Kuwer]

Die Datei herauszusuchen und aufzurufen reicht hier nicht, du musst auch über "Attachement hinzufügen" auf der rechten Seite, die Datei freigeben.

Das hat Chris so gemacht wie Du schreibst. Allerdings in einem (moderierten) Unterforum von Beispiele und Workshops. Beim "Portieren" ins richtige Forum lief leider anfangs irgendwie etwas schief mit dem Sichtbarmachen für alle User.  

Gruß Uwe

[Flotter Feger]

Hallo,

@Uwe: Danke schön ! :19: 

ChrisKay hat im anderen Forum bereits seine passende Antwort erhalten. Ich denke mal, er ist so zufrieden, dass er glatt vergessen hat hier auf die eingegangene Lösung hinzuweisen ... und da ich ihn eingeladen habe, die Datei hier zu posten ... tue ich nie wieder ... versprochen ... übernehme ich das jetzt eben ... :20: 

---

Gast76556 schrieb im VBA-Forum :

analog https://www.clever-excel-forum.de/thread-17824.html

PHP-Code:

Option Explicit
 
Sub RecordIt()
 
   With Sheets("Montagebericht")
    
      MkListFilter .Range("B1").Value, .Range("E3").Value, .Range("B4").Value, .Range("B5").Value, .Range("B11").Value, "delivered"
       
   End With
 
End Sub
 
 
Private Sub MkListFilter(ByVal Md As String, ByVal FS As String, _
   ByVal FrmNbr As Variant, ByVal SysNbr As Variant, ByVal Dte As Variant, ByVal State As String)
Dim Rw As Range
   With Sheets("Lagerbestand")
      With .ListObjects(1)
         .AutoFilter.ShowAllData
         With .Range
            .AutoFilter Field:=2, Criteria1:=Md
            .AutoFilter Field:=3, Criteria1:=FS
            .AutoFilter Field:=4, Criteria1:="storing"
         End With
         Set Rw = .DataBodyRange.SpecialCells(xlCellTypeVisible).Rows(1)
         Do Until Rw.Cells(8) = "" And Rw.Cells(7) = ""
            Set Rw = Rw.Offset(1)
         Loop
          
         Rw.Cells(8).Value = SysNbr
         Rw.Cells(7).Value = FrmNbr
         Rw.Cells(5).Value = Dte
         Rw.Cells(4).Value = State
          
         .AutoFilter.ShowAllData
      End With
   End With
 
End Sub 


---

ChrisKay Antwort darauf im VBA-Forum :

Hallo Gast 76556,
 
yes das läuft super. Hab vielen lieben Dank.
Beste Grüße
Chris

---

[ChrisKay86]

Hallo Zusammen,

der Code läuft aktuell echt klasse, nur ist jetzt noch ein weiteres Kriterium hinzugekommen. Ist es möglich die Rahmennummern noch mit abzugleichen, damit es nicht zur Doppelbuchung kommen kann? Also das man immer nur diesen einen Rahmen auch nur einmalig buchen kann, ansonsten sollte eine Massage Box aufgehen und mir den Hinweis geben, dass dieser Artikel schon vorhanden ist.

Beste Grüße
Chris

[schauan]

Hallo,

ist die Frage denn jetzt im VBA - Forum gelöst? Hier ist leider kein Link dabei, ChrisKay - siehe meine PN.

[ChrisKay86]

Hallo,

ist die Frage denn jetzt im VBA - Forum gelöst? Hier ist leider kein Link dabei, ChrisKay - siehe meine PN.

Hey Schauan,

erstmal hab ganz lieben Dank für deine PN (hab dir soeben eine Antwort geschickt). Also ja der erste Teil (das Filtern und Eintragen) ist gelöst. Jetzt fehlt leider noch der Abgleich, dass man die Rahmennummern nicht doppelt in die Tabelle eintragen kann.

Da ja das eine schon gelöst ist, soll ich das Thema als erledigt markieren und lieber ein neues Thema eröffnen?

Beste Grüße

Chris

[schauan]

Hallo Chris,

das ließe sich doch relativ einfach über eine Gültigkeitsregel realisieren?

Arbeitsblatt mit dem Namen 'Tabelle1'
	A
1	a
2

Zelle	Gültigkeitstyp	Operator	Wert1	Wert2
A1	Benutzerdefiniert		=ZÄHLENWENN(A:A;A1)<=1
A2	Benutzerdefiniert		=ZÄHLENWENN(A:A;A2)<=1

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg