Falsche Auswertung- nur jede zweite Zeile

Forumthread: Falsche Auswertung- nur jede zweite Zeile

17.07.2024 10:52:01

Kruemelmonstar

Ich erstelle gerade eine Ecxel eine Auswertung zu erstellen,
Es gibt eine Mappe, mit den Spaten Übersicht und Fassung.
In der Übersicht gebe ich werte ein, die in der Fassung wieder vorkommen. Da die Fasssung sehr lang werden wird soll nun durch ein Makro eine Suche erfolgenn und dies in der Übersiche wiedergeben.

Nun habe ich ein Probelauf gemacht und das Problem, das mein Makro nur jede zweite Zeile nimmt und auswertet.
Hintergrund ist, der Soll den wert in der entsprechenden Spalte suchen, die Ganze Zeile kopieren und bei Übersicht wiedergeben(Einfügen)

Warum ? - Mein Code

Sub Haus()

Dim rng As Range
Dim dbl_suchwert As Long
Dim sfirstaddress As String

dbl_suchwert = Worksheets("Übersicht").Range("C5")

Set rng = Range("A:A").Find(dbl_suchwert)

If Not rng Is Nothing Then

sfirstaddress = rng.Address

Do
rng.Range("A" & rng.Row & ".E" & "E" & rng.Row).Copy

Worksheets("Übersicht").Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

Set rng = Range("A:A").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address > sfirstaddress

Else

MsgBox "nicht gefunden"

End If
End Sub

https://www.herber.de/bbs/user/171047.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Falsche Auswertung- nur jede zweite Zeile

17.07.2024 11:26:51

MCO

Moin!

Der Code hat so seine Schwächen: Von Syntaxfehler bis fehlende Referenzierung... aber im Prinzip richtig,

Versuch mal die korrigierte Version:

Sub Haus()



    Dim rng As Range

    Dim dbl_suchwert As Long

    Dim sfirstaddress As String

    Dim sh_Übers As Worksheet 'sheet als Variable mit Namen

    

    Application.ScreenUpdating = False 'Bildschirmaktualisierung aus: schneller

    Set sh_Übers = Worksheets("Übersicht")

    dbl_suchwert = sh_Übers.Range("C5")

    

    With Sheets("Fassung") 'referenziert auf sheet

        Set rng = .Range("A:A").Find(dbl_suchwert)

        

        If Not rng Is Nothing Then

            sfirstaddress = rng.Address

        

            Do

                .Range("A" & rng.Row & ":E" & rng.Row).Copy sh_Übers.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) 'direktkopie

                Set rng = Range("A:A").FindNext(rng)

            Loop While Not rng Is Nothing And rng.Address > sfirstaddress

        Else

            MsgBox "nicht gefunden"

        End If

    End With

End Sub

Gruß, MCO

AW: Falsche Auswertung- nur jede zweite Zeile

17.07.2024 11:38:40

Kruemelmonstar

Vielen Lieben Dank für die Hilfe,
jedoch bleibe ich gleich am Ball und Frage nach, wie das Macro angepasst werden müsste, wenn ich nun nach der Etage suche.

dbl_suchwert = sh_Übers.Range("C5") -> ist jetzt nicht eine Zahle sondern der Wert OG, oder EG??

AW: Falsche Auswertung- nur jede zweite Zeile

17.07.2024 12:32:51

MCO

Hi!

Nach kleinen Änderungen sieht der Code so aus:

Sub Haus()



    Dim rng As Range

    Dim dbl_suchwert As String



    Dim sfirstaddress As String

    Dim sh_Übers As Worksheet 'sheet als Variable mit Namen

    

    Application.ScreenUpdating = False 'Bildschirmaktualisierung aus: schneller

    Set sh_Übers = Worksheets("Übersicht")

    dbl_suchwert = sh_Übers.Range("F5")

    

    With Sheets("Fassung") 'referenziert auf sheet

        Set rng = .Range("A:E").Find(dbl_suchwert)

        

        If Not rng Is Nothing Then

            sfirstaddress = rng.Address

        

            Do

                .Range("A" & rng.Row & ":E" & rng.Row).Copy sh_Übers.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) 'direktkopie

                Set rng = Range("A:E").FindNext(rng)

            Loop While Not rng Is Nothing And rng.Address > sfirstaddress

        Else

            MsgBox "nicht gefunden"

        End If

    End With

End Sub

Geändert habe ich, dass der Suchbegriff nicht Typ LONG sein muss (Ganzzahl) sondern STRING (Zeichenfolge). Damit ist der Suchbegriff nicht mehr auf eine Zahl begrenzt.
Außerdem hab ich den Suchbereich von Spalte "A" auf "A:E" erweitert. Da eh nur die gefundene Zeile benötigt wird und alles kopiert wird, ist es (fast) egal.
Mir fällt gerade auf, dass ja A + B den gleichen Inhalt haben, damit werden die auch doppelt gefunden :-(
Wir ändern den Bereich also Auf "B:E".

Anpassen:
Schieb den Code vom Tabellenblatt ins Modul1!
Ansonsten läuft das folgende nicht sauber!

Ich vermute, die nächste Frage ist die nach dem nächsten Feld?
Vorschlag:
Wir ändern den Code so, dass das gewählte Feld gesucht wird. Probier es mal aus:

Sub Haus()

    

    Dim rng As Range

    Dim dbl_suchwert As String

    Dim sfirstaddress As String

    Dim sh_Übers As Worksheet 'sheet als Variable mit Namen



    Dim gültig_rng  As Range

    Dim sel_ok

    

    Set gültig_rng = ActiveSheet.Range("C5,F5,F7:G7,C7") 'suchZellen: Bereich festlegen

    Set sel_ok = Application.Intersect(Selection, gültig_rng) 'Bereiche vergleichen



    If sel_ok Is Nothing Then MsgBox "Keine gültige Zelle gewählt": Exit Sub 'Ausstieg A

    If Selection = "" Then MsgBox "Kein Suchbegriff in der Zelle": Exit Sub 'Ausstieg B

    If Range("I2") > "" Then Range("I2").CurrentRegion.ClearContents 'gefundenen Bereich löschen

    

    Application.ScreenUpdating = False 'Bildschirmaktualisierung aus: schneller

    Set sh_Übers = Worksheets("Übersicht")

    dbl_suchwert = Selection

    

    With Sheets("Fassung") 'referenziert auf sheet

        Set such_rng = .Range("A:E")

        Set rng = such_rng.Find(dbl_suchwert)

        

        If Not rng Is Nothing Then

            sfirstaddress = rng.Address

        

            Do

                .Range("A" & rng.Row & ":E" & rng.Row).Copy sh_Übers.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) 'direktkopie

                Set rng = such_rng.FindNext(rng)

            Loop While Not rng Is Nothing And rng.Address > sfirstaddress

        Else

            MsgBox "nicht gefunden"

        End If

    End With

End Sub

Gruß, MCO

AW: Falsche Auswertung- nur jede zweite Zeile

17.07.2024 12:54:49

Kruemelmonstar

Das bei A und B die kleichen Zahlen waren ist nur zum test / Platzhalter gewesen. Verständlicher
Spalte A = 212
Spalte B = 12 oder 13 oder 14
Spalte C = EG oder OG oder DG

Falsche Auswertung- nur jede zweite Zeile

Forumthread: Falsche Auswertung- nur jede zweite Zeile

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Falsche Auswertung- nur jede zweite Zeile

Forumthread: Falsche Auswertung- nur jede zweite Zeile

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread