Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kriterien

Kriterien
24.09.2007 14:28:17
Christian
Hallo Leute,
Ich hab da ein kleines Problem. Ich möchte gern die entsprechende Zeile heraussuchen, bei der alle vier Kriterien zutreffen. Irgendwo mache ich aber einen Fehler. Kann da einer von Euch nochmal draufgucken ?
Das Makro kopiert zwar in die Tabelle "Archiv", aber leider eine völlig falsche Zeile ! Ich vermute, er setzt nach jeder Markierung neu an.
With Worksheets("Tabelle1")
Set gefunden = Worksheets("Tabelle1").Range("F10:F5000").Find(StückeNummer1)
If gefunden Is Nothing Then MsgBox ("Stücke-Nummer nicht gefunden !"): GoTo Ende
lZeile = gefunden.Row
iGefunden = iGefunden + 1
Set gefunden = Worksheets("Tabelle1").Range("G10:G5000").Find(KuponNummer_von)
If gefunden Is Nothing Then MsgBox ("Kuponnummer nicht gefunden !"): GoTo Ende
lZeile = gefunden.Row
iGefunden = iGefunden + 1
Set gefunden = Worksheets("Tabelle1").Range("H10:H5000").Find(Art_des_WP)
If gefunden Is Nothing Then MsgBox ("Art des WP nicht gefunden !"): GoTo Ende
lZeile = gefunden.Row
iGefunden = iGefunden + 1
Set gefunden = Worksheets("Tabelle1").Range("J10:J5000").Find(Zugangs_Buchungsbelegnummer1)
If gefunden Is Nothing Then MsgBox ("Zugangs-Buchungsbelegnummer nicht gefunden !"): GoTo Ende
lZeile = gefunden.Row
iGefunden = iGefunden + 1
If iGefunden = 4 Then
gefunden.EntireRow.Cut
Worksheets("Archiv").Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).EntireRow.Insert
Else: MsgBox ("Bestand nicht gefunden !"): GoTo Ende
End If

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
doppelt oT
24.09.2007 14:32:00
Jens

AW: doppelt oT
24.09.2007 14:39:00
Christian
Tut mir leid, - kleines Problem bei der Übertragung !!

AW: Kriterien
24.09.2007 14:49:46
Peter
Hallo Christian,
welche Zeile soll denn ausgeschnitten und kopiert werden?
Dein Makro schneidet bei mir die Zeile des zuletzt gefundenen Suchbegriffs "Zugangs_Buchungsbelegnummer1" aus und kopiert diese.
Es wird aber ständig - für jeden Suchbegriff - in der jeweils ganzen Spalte gesucht, nicht in den Zeilen der vorhergehenden Suchbegriffe.
Gruß Peter

AW: Kriterien
24.09.2007 15:05:00
Christian
Hallo Peter,
genau das ist das Problem. In der Zeile die kopiert werden soll sollen alle Kriterien zutreffen !
Sonst soll das Meldefenster angezeit werden, daß der Bestand nicht gefunden wurde.

Anzeige
AW: Kriterien
24.09.2007 15:45:41
Peter
Hallo Christian,
dann mach es so:
With Worksheets("Tabelle1")
Set gefunden = Worksheets("Tabelle1").Range("F10:F5000").Find(StückeNummer1)
If gefunden Is Nothing Then MsgBox ("Stücke-Nummer nicht gefunden !"): GoTo Ende
lzeile = gefunden.Row
If Worksheets("Tabelle1").Range("G" & lzeile).Value KuponNummer_von Then
MsgBox ("Kuponnummer nicht gefunden !")
Exit Sub
End If
If Worksheets("Tabelle1").Range("H" & lzeile).Value Art_des_WP Then
MsgBox ("Art_des_WP nicht gefunden !")
Exit Sub
End If
If Worksheets("Tabelle1").Range("J" & lzeile).Value Zugangs_Buchungsbelegnummer1 Then
MsgBox ("Zugangs_Buchungsbelegnummer1 nicht gefunden !")
Exit Sub
End If
gefunden.EntireRow.Cut
Worksheets("Archiv").Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).EntireRow.Insert
End With
Gruß Peter

Anzeige
AW: Kriterien
25.09.2007 09:11:00
Christian
Hallo Peter,
hab ich versucht, klappt leider nicht, weil er sucht bis er die erste Zeile mit der Sückenummer gefunden hat und dann in dieser Zeile nachschaut, ob die Kuponnr. mit der eingegebenen übereinstimmt. Tut sie aber nicht, da er nur die erste Zeile durchsucht. Meldung folglich: "Kuponnummer nicht gefunden !"
hast Du noch einen anderen Tipp ?

AW: Kriterien
25.09.2007 13:22:00
Christian
Hallo Peter,
Kannst Du mir den VBA-Code vielleicht reinkopieren ? Die Fire-Wall meiner Firma läßt ein herunterladen leider nicht zu. Ich muß sonst leider hier abbrechen und kann erst heute Abend von zu hause reinschauen!
Danke

Anzeige
AW: Kriterien
26.09.2007 14:24:00
Peter
Hallo Christian,
wohin soll ich dir das Makro kopieren?
Meinst du es so?


'
'    es soll kopiert werden, wenn alle VIER Suchbegriffe in einer Zeile gefunden wurden
'
Public Sub SuchenKopieren()
Dim WkSh                          As Worksheet
Dim StückeNummer1                 As Integer
Dim KuponNummer_von               As Integer
Dim Art_des_WP                    As Integer
Dim Zugangs_Buchungsbelegnummer1  As Integer
Dim rZelle                        As Range
Dim sFundst                       As String
   Application.ScreenUpdating = False
   Set WkSh = Worksheets("Tabelle1") ' <== Tabellenblattnamen ggf. anpassen !!!
   StückeNummer1 = 4711
   KuponNummer_von = 4812
   Art_des_WP = 4913
   Zugangs_Buchungsbelegnummer1 = 5014
   With WkSh.Columns(6)  ' suchen in Spalte F
      Set rZelle = .Find(StückeNummer1, LookIn:=xlValues, LookAt:=xlWhole)
      If Not rZelle Is Nothing Then
         sFundst = rZelle.Address
         Do
            If WkSh.Range("G" & rZelle.Row).Value = KuponNummer_von And _
               WkSh.Range("H" & rZelle.Row).Value = Art_des_WP And _
               WkSh.Range("J" & rZelle.Row).Value = Zugangs_Buchungsbelegnummer1 Then
               rZelle.EntireRow.Cut
               Worksheets("Archiv").Cells(.Rows.Count, "C").End(xlUp) _
                  .Offset(1, 0).EntireRow.Insert
            End If
            Set rZelle = .FindNext(rZelle)
         Loop While Not rZelle Is Nothing And rZelle.Address <> sFundst
      Else
         MsgBox "Stücke-Nummer wurde nicht gefunden !", _
            48, "   Hinweis für " & Application.UserName
      End If
   End With
   Application.ScreenUpdating = True
End Sub 


Gruß Peter
Anzeige
AW: Kriterien
27.09.2007 14:49:00
Christian
Danke Peter.
Echt klasse, funktioniert auch in der Beispieltabelle.
Leider aber nicht in meiner Tabelle.
Kann ich Dir die Tabelle vielleicht mal zukommen lassen, damit Du dierekt einen Blick darauf wirfst ?

AW: Kriterien
27.09.2007 15:28:36
Christian
Hallo Peter nochmal
an der folgenden Stelle gibt er die Meldung "Loop ohne Do"
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
warum, steht doch weiter oben !

AW: Kriterien
25.09.2007 11:47:56
Peter
Hallo Christian,
noch etwas deutlicher, das jetzige Verfahren: https://www.herber.de/bbs/user/46318.xls
Gruß Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige