Makro für die Preisabfrage aus bestimmten Preisblättern wenn Suchkriterien eingegeben wurden

  • Excel

Es gibt 21 Antworten in diesem Thema. Der letzte Beitrag () ist von INOPIAE.

    Makro für die Preisabfrage aus bestimmten Preisblättern wenn Suchkriterien eingegeben wurden

    Hallo zusammen,
    ich bin neu hier und ein VBA Anfänger. Ich benötige Hilfe bei der Umsetzung eines Makros. Ich habe eine Arbeitsmappe mit mehreren Arbeitsblättern. Wenn in dem Arbeitsblatt "Data" das Produkt, Größe und Farbe ausgewählt wird, soll eine Preissuchen in den Arbeitsblättern pants, shirts oder shoes durchgeführt und der dazugehörige Preis in dem Arbeitsblatt Data ab Spalte E2 eingetragen werden. Ich würde mich freuen, wenn mich jemand bei Umsetzung des Makros unterstützen könnte. Anhängend meine Arbeitsmappe dazu.
    Dateien
    • Test.xlsx

      (16,25 kB, 68 mal heruntergeladen, zuletzt: )
    Mal so einen Psyeudo Code:

    Visual Basic-Quellcode

    1. Dim wks as worksheet
    2. dim wksData as worksheet
    3. set wksData = sheets("data")
    4. For lngRow = 2 to Ende
    5. select case wksData.cells(lngRow,1).value
    6. case "pants"
    7. set wks =Sheets("pants")
    8. ....
    9. end select
    10. for lngRow2 = 2 to Ende
    11. if wks.cells(lngRow2,2).value = wksData.cells(lngrow,2).value then
    12. for lngSpalte=2 to 10
    13. if wks.cells(2,lngSpalte).value=wksdata.cells(lngRow,3) then
    14. wksdata.cells(lngrow,5).value=wks.cells(lngrow2,lngSplate).value
    15. exit for
    16. end if
    17. end if
    18. next
    19. next


    Den Code musst Du noch ein bisschen aus formulieren.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).
    Guten Morgen,
    habe jetzt folgenden code zusammengefügt. Funktioniert aber nicht. Er bleibt schon am Anfang bei "For lngrow = 2 To Ende" hängen. Was mache ich falsch?

    Visual Basic-Quellcode

    1. Sub Getprice()
    2. Dim wks As Worksheet
    3. Dim wksData As Worksheet: Set wksData = Sheets("Data")
    4. Dim lngrow As Range: Set lngrow = wksData.Range("A2:A10")
    5. Dim lngrow2 As Range: Set lngrow2 = wksData.Range("B2:B10")
    6. Dim lngSpalte As Range: Set lngSpalte = wksData.Range("C2:C")
    7. Dim Ende As Range: Set Ende = wksData.Range("A2:D5")
    8. For lngrow = 2 To Ende
    9. Select Case wksData.Cells(lngrow, 1).Value
    10. Case "pants"
    11. Set wks = Sheets("pants")
    12. Case "shirts"
    13. Set wks = Sheets("shirts")
    14. Case "Shoes"
    15. Set wks = Sheets("shoes")
    16. End Select
    17. For lngrow2 = 2 To Ende
    18. If wks.Cells(lngrow2, 2).Value = wksData.Cells(lngrow, 2).Value Then
    19. For lngSpalte = 2 To 10
    20. If wks.Cells(2, lngSpalte).Value = wksData.Cells(lngrow, 3) Then
    21. wksData.Cells(lngrow, 5).Value = wks.Cells(lngrow2, lngSplate).Value
    22. Exit For
    23. End If
    24. End If
    25. Next
    26. Next
    27. End Sub


    CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Ende muss vom Typ integer oder Long sein und ist die Zeilennummer der letzten beschrieben Zeile vom Blatt Data.

    Diese Nummer solltest Du am besten nicht festvorgeben, sondern aus dem Code heraus ermitteln.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).
    Danke petaod. Jetzt habe ich bei dem End If eine Fehlermeldeung: End If without block If
    In dem Code ist aber ein If als Block drin.

    Visual Basic-Quellcode

    1. Dim wks As Worksheet
    2. Dim wksData As Worksheet: Set wksData = Sheets("Data")
    3. Dim lngrow As Integer
    4. Dim lngrow2 As Integer
    5. Dim lngSpalte As Integer
    6. For lngrow = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    7. Select Case wksData.Cells(lngrow, 1).Value
    8. Case "pants"
    9. Set wks = Sheets("pants")
    10. Case "shirts"
    11. Set wks = Sheets("shirts")
    12. Case "Shoes"
    13. Set wks = Sheets("shoes")
    14. End Select
    15. For lngrow2 = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    16. If wks.Cells(lngrow2, 2).Value = wksData.Cells(lngrow, 2).Value Then
    17. For lngSpalte = 2 To 10
    18. If wks.Cells(2, lngSpalte).Value = wksData.Cells(lngrow, 3) Then
    19. wksData.Cells(lngrow, 5).Value = wks.Cells(lngrow2, lngSpalte).Value
    20. Exit For
    21. End If
    22. End If
    23. Next


    CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Sorry, dass hatte ich schon drin. Ist beim Kopieren nicht rüber bzw. war nicht zu sehen. Scheint tatsächlich an der If Anweisung zu liegen.

    Visual Basic-Quellcode

    1. For lngrow = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    2. Select Case wksData.Cells(lngrow, 1).Value
    3. Case "pants"
    4. Set wks = Sheets("pants")
    5. Case "shirts"
    6. Set wks = Sheets("shirts")
    7. Case "Shoes"
    8. Set wks = Sheets("shoes")
    9. End Select
    10. For lngrow2 = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    11. If wks.Cells(lngrow2, 2).Value = wksData.Cells(lngrow, 2).Value Then
    12. For lngSpalte = 2 To 10
    13. If wks.Cells(2, lngSpalte).Value = wksData.Cells(lngrow, 3) Then
    14. wksData.Cells(lngrow, 5).Value = wks.Cells(lngrow2, lngSpalte).Value
    15. Exit For
    16. End If
    17. End If
    18. Next
    19. Next


    CodeTags korrigiert ~VaporiZed
    siehe verfügbare CodeTags ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hier der Code der läuft:

    Visual Basic-Quellcode

    1. Sub import()
    2. Dim wks As Worksheet
    3. Dim wksData As Worksheet: Set wksData = Sheets("Data")
    4. Dim lngrow As Integer
    5. Dim lngrow2 As Integer
    6. Dim lngSpalte As Integer
    7. For lngrow = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    8. Select Case wksData.Cells(lngrow, 1).Value
    9. Case "pants"
    10. Set wks = Sheets("pants ")
    11. Case "shirts"
    12. Set wks = Sheets("shirts ")
    13. Case "Shoes"
    14. Set wks = Sheets("shoes ")
    15. End Select
    16. For lngrow2 = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    17. If wks.Cells(lngrow2, 2).Value = wksData.Cells(lngrow, 2).Value Then
    18. For lngSpalte = 2 To 10
    19. If wks.Cells(2, lngSpalte).Value = wksData.Cells(lngrow, 3) Then
    20. wksData.Cells(lngrow, 5).Value = wks.Cells(lngrow2, lngSpalte).Value
    21. Exit For
    22. End If
    23. Next
    24. End If
    25. Next
    26. Next
    27. End Sub


    Wer hat den Anwendern nur beigebracht, nach jeder Eingabe noch ein Leerzeichen zusetzen. Es lebe der Anwender mit eingebauter Trim-Funktion in den Fingern. ;)
    Die Tabellenblätter haben jeweils noch ein Leerzeichen am Ende des Namens.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).
    Hallo INOPIAE, hallo petaod, die lngrow und Spalte Variablen sind aktuell als Integer deklariert. Wir haben aber in dem Sheet Data in Spalte A und C Text als Suchkriterium und Spalte B ein Mix (Zahl&Text) Kann es daran liegen, dass hier kein Ergebnis angezeigt wird?

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Gojko“ ()

    Gojko schrieb:

    lngrow und Spalte Variablen sind aktuell als Integer deklariert
    Das ist soweit OK.
    Das sind ja die Nummern der Zeilen und Spalten.
    Ganz korrekt wäre, die Zeilen als Long zu deklarieren, weil die Zeilenuzahl theoretisch den Maximalwert eines Integer (65535) übersteigen könnte.

    Gojko schrieb:

    Wir haben aber in dem Sheet Data in Spalte A und C Text als Suchkriterium und Spalte B ein Mix
    Wenn du nicht die richtigen Werte für deine Daten bekommst, dann hilft wohl nur debuggen.
    Geh einfach mal im Snglestep durch und überprüfe die Variableninhalte.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Visual Basic-Quellcode

    1. Sub import()
    2. Dim wks As Worksheet
    3. Dim wksData As Worksheet: Set wksData = Sheets("Data")
    4. Dim lngrow As Long
    5. Dim lngrow2 As Long
    6. Dim lngSpalte As Long
    7. For lngrow = 2 To wksData.Cells(Rows.Count, 1).End(xlUp).Row
    8. Select Case wksData.Cells(lngrow, 1).Value
    9. Case "pants"
    10. Set wks = Sheets("pants ")
    11. Case "shirts"
    12. Set wks = Sheets("shirts ")
    13. Case "shoes"
    14. Set wks = Sheets("shoes ")
    15. End Select
    16. For lngrow2 = 2 To wks.Cells(Rows.Count, 1).End(xlUp).Row
    17. If Trim(wks.Cells(lngrow2, 1).Value) = Trim(wksData.Cells(lngrow, 2).Value) Then
    18. For lngSpalte = 2 To 10
    19. If Trim(wks.Cells(2, lngSpalte).Value) = Trim(wksData.Cells(lngrow, 3)) Then
    20. wksData.Cells(lngrow, 5).Value = wks.Cells(lngrow2, lngSpalte).Value
    21. Exit For
    22. End If
    23. Next
    24. End If
    25. Next
    26. Next
    27. End Sub


    Primär waren es weiter Leerzeichen die fehlgeschlagen sind. Siehe oben
    Dies habe ich durch Trim umgangen.
    Ein weiterer Fehler war, die im Select Case muss es statt "Shoes" "shoes" heißen.
    In Zeile 17 muss das Ende in dem Worksheet wks und nicht in wksData gesucht werden.
    Und einen weiteren Fehler habe ich auch noch korrigiert, schau mal ob Du den findest Gojko.
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).
    Vielen Dank INOPIAE! Du hast noch den Wert von 2 auf 1 angepasst: lngrow2, 1). Und die Variablen hast du auf Long umgestellt. Ich hatte vorher schon deinen Hinweis in den Tabellen mit dem Leerzeichen wahrgenommen und das auch in der Tabelle ohne Leerzeichen angepasst. Auch die Groß bzw. Kleinschreibung von "Shoes" "shoes. Ich danke dir und petaod für die Unterstützung. Ich muss noch vieeeel im Bezug auf debuggen lernen. Auch das Verständnis für den Aufbau fehlt mir noch, ich denke aber, dass ich auf einen guten Weg bin. Danke nochmlas!!