VBA Suche nach 1 Kriterium + innerhalb einer KW - Ausgabe auf anderem Tabellenblatt

  • Excel

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Nickerchen.

    VBA Suche nach 1 Kriterium + innerhalb einer KW - Ausgabe auf anderem Tabellenblatt

    Guten Tag,

    ich habe zwar ein ähnliches Thema gefunden, aber leider nicht genau dass was Ich brauche.

    Ich habe versucht (mit Hilfe von Google), mir einen Code zu basteln, der in einem Blatt in einer bestimmten Spalte nach einem Wert Sucht der wiederum über einen Zellbezug festgelegt wird.

    So sieht das bei mir aus, funktioniert allerdings schon mal nicht....

    Visual Basic-Quellcode

    1. Sub FindenUndKopieren()
    3. Dim ZellenInhalt As String
    5. Dim rng As Range
    6. Dim loDeinWert As Long
    7. Dim sfirstaddress As String
    9. ZellenInhalt = Worksheets("4-Wochen").Range("B3").Value
    10. loDeinWert = ZellenInhalt 'gesuchter Wert
    12. Set rng = Worksheets("AX").Range("K:K").Find(loDeinWert)
    14. If rng Is Nothing Then
    15. MsgBox "Wert " & loDeinWert & " nicht gefunden!"
    16. Else
    17. sfirstaddress = rng.Address
    18. Do
    19. rng.EntireRow.Copy
    20. Worksheets("Tabelle1").Cells(Rows.Count, "A").End(xlUp) _
    21. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
    22. Set rng = Worksheets("AX").Range("K:K").FindNext(rng)
    23. Loop While Not rng Is Nothing And rng.Address <> sfirstaddress
    24. End If
    26. End Sub


    Gesucht werden soll nach dem Wert aus Zelle B3 des Blatts "4-Wochen".
    Die Werte sollen im Blatt "AX" Spalte K gesucht werden.
    Alle gefunden Werte sollte mir der Code im "Tabellenblatt1" untereinander kopieren. (die ganze Zeile des gefundenen Wertes)

    Kann mir hierzu jemand bitte meine Fehler aufzeigen?

    Ich würde den Code auch gern noch erweitern dass er mir nur die Werte innerhalb einer festgelegten Kalenderwoche ausgibt. Die KW wird im Blatt "4-Wochen" Zelle B2 festgelegt.


    Bin dankbar für jede Antwort
    MfG B. Mühlburger

    Guten Tag,

    ich habe bereits Hilfe bekommen und falls jmd ein ähnliches Problem haben sollte, hier die beiden Codes.

    Einfache Variante nach einem Kriterium suchen:

    Visual Basic-Quellcode

    1. Sub FindenUndKopieren()
    3. Dim ZellenInhalt As String
    4. Dim rng As Range
    5. Dim loDeinWert As Long
    6. Dim sfirstaddress As String
    8. loDeinWert = Worksheets("Übersicht").Range("B3").Value 'gesuchter Wert
    10. Set rng = Worksheets("AX").Range("L:L").Find(loDeinWert) 'wo wird gesucht
    12. If rng Is Nothing Then
    13. MsgBox "Wert " & loDeinWert & " nicht gefunden!"
    14. Else
    15. sfirstaddress = rng.Address
    16. Do
    17. rng.EntireRow.Copy
    18. Worksheets("Tabelle1").Cells(Rows.Count, "A").End(xlUp) _
    19. .Offset(1, 0).PasteSpecial Paste:=xlPasteAll 'Ziel zum kopieren
    20. Set rng = Worksheets("AX").Range("L:L").FindNext(rng)
    21. Loop While Not rng Is Nothing And rng.Address <> sfirstaddress
    22. End If
    24. End Sub


    Nach 2 Kriterien suchen:

    Visual Basic-Quellcode

    1. Sub MeinFindenundKopieren()
    2. Dim rngWhat As Range, rngWeek As Range, rngRow As Range, rngTarget As Range
    3. Dim intCnt As Integer
    5. 'Bedingung1
    6. Set rngWhat = Sheets("Übersicht").Range("B3")
    7. 'Bedingung2
    8. Set rngWeek = Sheets("Übersicht").Range("B2")
    10. 'alle Zeilen
    11. For Each rngRow In Sheets("AX").UsedRange.Rows
    12. 'Bedingung1 in Spalte L = 11.Spalte
    13. If rngRow.Cells(12) = rngWhat Then intCnt = intCnt + 1
    14. 'Bedingung2 in Spalte G = 7.Spalte
    15. If rngRow.Cells(7) = rngWeek Then intCnt = intCnt + 1
    16. 'auswerten
    17. If intCnt = 2 Then _
    18. rngRow.Copy Sheets("Tabelle1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    19. 'Ziel zum kopieren
    20. intCnt = 0
    21. Next rngRow
    22. End Sub


    MfG

Facebook
Telefonspende