Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1264to1268
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
VBA:find schleife
dani
Hallo Nepumuk, Björn, Rainer, und all Ihr Excel-Spezl's,
ich habe folgendes Problem an dem ich seit Tagen schon "herumschustere".
Aus dem Archiv habe ich schon viele Lösungen gefunden, dennoch komme ich
nicht weiter.
Folgende Situation:
- 3 Tabellenblätter:
    => "FB-Übersicht CR" - diese ist sozusagen der Master, der immer
aktuell sein muss
    => "gelöscht" - hier sind die Suchbegriffe/Artikel-Nr. enthalten, die
aus dem Master gelöscht werden sollen
           = temporäres Blatt, was wöchentlich mit den
changes/deletions/new SKUs aktualisiert wird
    => "Gelöschte AAs" - diese soll zum Review dienen und alle aus dem
Master gelöschten Artikel-Nr mit dem Lösch-Datum enthalten
Was ich nun brauche:
In Tabelle "gelöscht" stehen immer unterschiedliche Artikel-Nr. in Spalte
A. Diese sollen im Master
= "FB-Übersicht CR" in der Spalte A gefunden werden. Sobald dort gefunden,
soll die gesamte Zeile kopiert, in Tabelle "gelöschte AAs" übertragen
werden und aus dem Master gelöscht werden. Zusätzlich
soll in Tabelle "gelöschte AAs" in Spalte F das Datum der Ausführung des
Makros als value eingetragen werden. Ihr werdet sehen, dass im code noch
seltsame Versuche enthalten sind,  nur die range der Artikel-Nr.
einzugrenzen im Blatt "gelöscht" & "gelöschte AAs". Keine Ahnung ob ich die
überhaupt brauche ...
Ich habe den nachfolgenden Code aus verschiedenen Archiv-Beiträgen
zusammengestellt, aber  _
leider weiss ich keinen Rat mehr und bitte Euch um Hilfe.

Sub test()
    Dim sku, nextsku, lsku As Variant
    Dim ersteadresse, letzteadresse As String
   Dim firstaddress As String
    x = Worksheets("gelöschte aas").UsedRange.Rows.Count
    y = Application.WorksheetFunction.VLookup(Worksheets("gelöscht").Range
("A1:A10"), Sheets("   _
FB-Übersicht CR").Range("A:A"), 1, False)
    With Sheets("FB-Übersicht CR").Columns(1)
    Set sku = .Find(what:=Sheets("Gelöscht").Cells(1, 1), LookIn:=xlValues)
        If Not sku Is Nothing Then
            ersteadresse = AA.Address
            lsku = Sheets("Gelöscht").Range("A:a").SpecialCells
(xlLastCell).Address
        Do
            Sheets("FB-Übersicht CR").Rows(sku.Row).EntireRow.Copy
Destination:=Sheets("Gelö _
schte AAs"). _
            Cells(x + 1, 1).EntireRow
        Set nextsku = .FindNext(sku)
        Loop While Not AA Is Nothing And ersteadresse  AA.Address
        End If
    End With
'    Application.ScreenUpdating = True
End Sub

Ich bin der totale VBA-Anfänger und habe sicherlich im code oben einiges
durcheinander gebracht, falsch gemacht, etc. denn mir wird immer nur der 1.
gefundene kopiert - die Suche wird nicht fortgesetzt ...? Das Löschen habe
ich nicht drin im code, weil ich erst testen wollte ... aber soweit komm
ich ja schon gar nicht ...
Ich bedanke mich schon mal für Eure Mühe & Verständnis für den Anfänger!
VG Dani

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA:find schleife
15.06.2012 15:03:47
guentherh
wenn ich richtig lese, solltest Du "AA" durch"sku" ersetzen (3x)
Gruß,
Günther
AW: VBA:find schleife
15.06.2012 17:17:02
fcs
Hallo Dani,
versuche dein Glück mal mit folgender nicht getesteten Variante.
Gruß
Franz
Sub test()
Dim sku As Range
Dim ersteadresse As String, bolDelete As Boolean
Dim wksCR As Worksheet, wksGeloescht As Worksheet, wksAAs As Worksheet
Dim LastRowAAs As Long, Rowgeloescht As Long
Set wksAAs = Worksheets("gelöschte aas")
Set wksCR = Worksheets("FB-Übersicht CR")
Set wksGeloescht = Worksheets("Gelöscht")
Application.ScreenUpdating = False
With wksAAs
LastRowAAs = wksGeloescht.Cells(.Rows.cout, 1).End(xlUp).Row
End With
With wksGeloescht
Rowgeloescht = wksGeloescht.Cells(.Rows.cout, 1).End(xlUp).Row
End With
For Rowgeloescht = 1 To Rowgeloescht
If wksGeloescht.Cells(Rowgeloescht, 1)  "" Then
With wksCR.Columns(1)
Set sku = .Find(what:=wksGeloescht.Cells(Rowgeloescht, 1), LookIn:=xlValues, lookat:= _
xlWhole)
If Not sku Is Nothing Then
ersteadresse = sku.Address
Do
LastRowAAs = LastRowAAs + 1
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlFormats
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
wksAAs.Cells(LastRowAAs, 6).Value = Date
sku.EntireRow.Clear
bolDelete = True
Set sku = .FindNext(after:=sku)
Loop Until ersteadresse = sku.Address
End If
End With
End If
Next Rowgeloescht
With wksCR
.Activate
If bolDelete = True Then
With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End If
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: VBA:find schleife
15.06.2012 19:10:18
Dani
Hallo Franz, Günther,
@Franz - 1000 Dank für das Erstellen des Codes. Leider erhalte ich einen "Laufzeitfehler 1004" an dem Punkt wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlFormats (nach dem DO). Was muss ich da korrigieren?
@Günther, vielen Dank für die Nachricht - leider haben die Änderungen von "AA" auf "SKu" nicht geholfen.
Vielen Dank vorab!
Dani
AW: VBA:find schleife
15.06.2012 19:40:31
fcs
Hallo Dani,
da waren mir im Blindflug doch ein paar Flüchtigkeitsfehler passiert. Ich hab die3 Blätter jetzt mal nachgebaut.
So sollte es jetzt funktionieren.
Gruß
Franz
Sub geloeschte_entfernen()
Dim sku As Range
Dim bolDelete As Boolean
Dim wksCR As Worksheet, wksGeloescht As Worksheet, wksAAs As Worksheet
Dim LastRowAAs As Long, Rowgeloescht As Long
Set wksAAs = Worksheets("gelöschte aas")
Set wksCR = Worksheets("FB-Übersicht CR")
Set wksGeloescht = Worksheets("Gelöscht")
Application.ScreenUpdating = False
With wksAAs
LastRowAAs = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksGeloescht
Rowgeloescht = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For Rowgeloescht = 1 To Rowgeloescht
If wksGeloescht.Cells(Rowgeloescht, 1)  "" Then
With wksCR.Columns(1)
Set sku = .Find(what:=wksGeloescht.Cells(Rowgeloescht, 1), LookIn:=xlValues, _
lookat:=xlWhole)
If Not sku Is Nothing Then
Do
LastRowAAs = LastRowAAs + 1
sku.EntireRow.Copy
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteFormats
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wksAAs.Cells(LastRowAAs, 6).Value = Date
sku.EntireRow.Clear
bolDelete = True
Set sku = .FindNext(after:=sku)
Loop Until sku Is Nothing
End If
End With
End If
Next Rowgeloescht
With wksCR
.Activate
If bolDelete = True Then
With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End If
End With
Application.ScreenUpdating = True
End Sub

Anzeige
PERFEKT !!!
15.06.2012 20:07:37
Dani
Das klappt HERVORRAGEND!!! Vielen, vielen, vielen Dank Franz!
Da ich neu im Forum bin habe ich noch die Frage, wie oft & lange ich Euch Spezialisten "belästigen" darf? Selbstverständlich erst nachdem ich erfolglos die Archiv-Suche durchstöbert und ähnliche Codes versucht habe anzupassen.
Sonnige Grüße aus Stgt
Dani
... doch noch 1 Frage
15.06.2012 22:42:36
Dani
Guten ABend Franz,
ich habe die ganze Zeit bis jetzt versucht, noch einen Punkt aufzunehmen aber ich krieg es nicht hin. Würdest Du mir bitte nochmal behilflich sein?
Das Blatt wksGeloescht enthält ja die zu löschenden Artikel als Suchbegriff - anhand dessen dann die Aktionen ausgeführt werden. In der Spalte L steht pro Artikel-Nr. auch der Text, warum diese Artikel-Nr. gelöscht wird. Diesen Text würde ich ganz gerne in dem Blatt wksAAs in der Spalte J anzeigen lassen.
Was muss im code geändert/ergänzt werden?
Vielen Dank nochmal & Grüße
Dani
Anzeige
pack einfach noch ne Variable dazu ...
16.06.2012 08:46:09
Matthias
Hallo
Könnte man so machen:
Hab das Eingefügte fett markiert mit einem '* dahinter
Option Explicit
Sub geloeschte_entfernen()
Dim sku As Range
Dim bolDelete As Boolean
Dim wksCR As Worksheet, wksGeloescht As Worksheet, wksAAs As Worksheet
Dim LastRowAAs As Long, Rowgeloescht As Long
Dim Grund$ '*
Set wksAAs = Worksheets("gelöschte aas")
Set wksCR = Worksheets("FB-Übersicht CR")
Set wksGeloescht = Worksheets("Gelöscht")
Application.ScreenUpdating = False
With wksAAs
LastRowAAs = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksGeloescht
Rowgeloescht = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For Rowgeloescht = 1 To Rowgeloescht
If wksGeloescht.Cells(Rowgeloescht, 1)  "" Then
 Grund = wksGeloescht.Cells(Rowgeloescht, 12).Value '*
With wksCR.Columns(1)
Set sku = .Find(what:=wksGeloescht.Cells(Rowgeloescht, 1), LookIn:=xlValues, _
lookat:=xlWhole)
If Not sku Is Nothing Then
Do
LastRowAAs = LastRowAAs + 1
sku.EntireRow.Copy
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteFormats
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wksAAs.Cells(LastRowAAs, 6).Value = Date
wksAAs.Cells(LastRowAAs, 7).Value = Grund
sku.EntireRow.Clear
bolDelete = True
Set sku = .FindNext(after:=sku)
Loop Until sku Is Nothing
End If
End With
End If
Next Rowgeloescht
With wksCR
.Activate
If bolDelete = True Then
With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End If
End With
Application.ScreenUpdating = True
End Sub
https://www.herber.de/bbs/user/80582.xls
Gruß Matthias
Anzeige
Einfach FANTASTISCH!!
16.06.2012 10:15:15
Dani
BESTEN DANK, Matthias!
Wahrscheinlich denke ich komplizierter als wie es letzten Endes ist ...
Ich bewundere Euch "Zauberer" :-)
AW: VBA:find schleife
15.06.2012 19:42:52
Franc
Das am Anfang bei bei den 2 "count" das "n" fehlt hast schon beseitigt richtig?
Ansonsten änder das wie folgt ab (fehlt denk hinten nur noch mal das "paste")
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteFormats
wksAAs.Rows(LastRowAAs).PasteSpecial Paste:=xlPasteValues
AW: VBA:find schleife
15.06.2012 20:11:59
Dani
Hallo Franc - ja, das count hatte ich schon korrigiert aber das beim pasten was fehlte habe ich nicht entdeckt. Jetzt weiss ich aber, wie es richtig heissen müsste und ich hoffe, dass ich in Zukunft das auch so schnell werde erblicken können :-)
Auch Dir besten Dank für die sofortige Hilfe!
VG
Dani
Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige