Office: (Office 2010) VBA Problem = Werte in 2 Dateien vergleichen und Zeilen kopieren

Hallo Community,

ich habe folgendes Problem.

ich habe eine Liste in dieser sind Artikel aufgezählt.
In Spalte A sind spezielle Nummern zu jedem Artikel (wie z.B. in A2 = 1348237 , A3 = 2516157 usw.).
Jetzt möchte ich nach diesen Zelleninhalten aus Spalte A (datei 1) in unserer Bestandsliste (datei 2)suchen lassen.
Falls das Makro fündig wird sollte die ganze Zeile in tabelle2 kopiert und untereinander aufgelistet werden.

Die Werte können in der Bestandsliste doppelt oder dreifach vorkommen. Das Makro sollte wenn möglich alle Zeilen mit dem Zelleninhalt kopieren und nicht nur die oberste Zeile.


diesbezüglich habe ich folgendes Makro erstellt.

Sub SuchenUndGanzeZeileKopieren()

Dim Anzahl As Long, A As Long
Dim SZelle As Range
Dim Suchwert As String

Suchwert = "1348237" 'Suchbegriff

Anzahl = Application.WorksheetFunction.CountIf(Tabelle1.Range("A:A"), Suchwert)

For A = 1 To Anzahl
If A = 1 Then
Set SZelle = Tabelle1.Range("A:A").Find(Suchwert)
Rows(SZelle.Row).Copy Tabelle2.Cells(A, 1) 'ganze Zeile Kopieren
Else
Set SZelle = Tabelle1.Range("A:A").FindNext(SZelle)
Rows(SZelle.Row).Copy Tabelle2.Cells(A, 1) 'ganze Zeile Kopieren
End If
Next A

End Sub

Bei diesem Makro muss ich die Nummer eingeben. Ich weiß nicht wie ich das umschreiben muss damit er mir jede Zelle (mit einem Wert) in Spalte A in einer anderen Datei sucht.

Was mir noch aufgefallen ist wenn ich dieses Makro ausführe, kopiert er mir das was er findet in Zeile 1. Bis dahin alles schön und gut, nur wenn ich weitersuche und noch ein Artikel finde wird es nicht untereinander eingefügt sondern das erste wird überschrieben.

Ich hoffe ich konnte mich verständlich ausdrücken.

Mfg

crunkfox

 

Hallo Crunkfox,

ich gehe jetzt mal davon aus, dass du noch nicht allzuviel Erfahrung mit VBA hast.
Daher eine übersichtliche und auf Deinem Code basierende Lösung:

Code:

Sub SuchenUndGanzeZeileKopieren()

Dim Anzahl As Long, A As Long
Dim SZelle As Range
Dim Suchwert As String
Dim LetzteZeile As Long, Zeile As Long, EZeile As Long
Dim WBA As Workbook, WBB As Workbook
Dim WSA As Worksheet, WSB As Worksheet, WSE As Worksheet

Set WBA = Workbooks("Artikelliste.xlsm")
Set WBB = Workbooks("Bestandsliste.xlsx") 'Ziel, Workbook mit diesem Makro

Set WSA = WBA.Worksheets("Tabelle1")
Set WSB = WBB.Worksheets("Tabelle1")
Set WSE = WBB.Worksheets("Tabelle2")

WSA.Activate
LetzteZeile = WSA.UsedRange.SpecialCells(xlCellTypeLastCell).Row
EZeile = 1

For Zeile = 1 To LetzteZeile

    'Suchwert = "1348237" 'Suchbegriff
    Suchwert = Cells(Zeile, 1)
    
    Anzahl = Application.WorksheetFunction.CountIf(WSB.Range("A:A"), Suchwert)
    
    For A = 1 To Anzahl
        If A = 1 Then
            WSB.Activate
            Set SZelle = WSB.Range("A:A").Find(Suchwert)
            Rows(SZelle.Row).Copy WSE.Cells(EZeile, 1) 'ganze Zeile Kopieren
            WSE.Activate
        Else
            WSB.Activate
            Set SZelle = WSB.Range("A:A").FindNext(SZelle)
            Rows(SZelle.Row).Copy WSE.Cells(EZeile, 1) 'ganze Zeile Kopieren
            WSE.Activate
        End If
        EZeile = EZeile + 1
        WSA.Activate
    Next A
Next Zeile

End Sub

Funktioniert, ist aber langsam und der Bildschirm flackert wie wild. Lässt sich über Felder wesentlich schneller erledigen.

Gruß,
Lutz

 

Hallo Lutz,

das Makro funktioniert zur hälfte.
ich sehe zwar welche Artikel ich schonmal im Bestand hatte jedoch nicht mit wieviel stück.
Das Makro kopiert nicht die ganze Zeile sondern nur die Spezielle Nummer und die Artikelbezeichnung (Spalten A+B).

Artikelliste:

NAN Artikelbezeichnung Altbestand
0034557 BUEGELTISCH
0523104 KARTUSCHE
1112964 WAESCHEWANNE
1124191 SCHNEIDEBRETT
1124192 SCHNEIDEBRETT
1228875 STABMIXER
1316096 KOMFORTSCHAUMMATRATZE
1316097 KOMFORTSCHAUM MATRATZE 7-Z.140X 200
1348237 STABMIXER
1456788 FRITTEUSE
1954656 KOMFORTSCHAUM MATRATZE 140X200CM 1ST YB
1954662 KOMFORTSCHAUMMATRATZE 7-ZONEN 1ST YB
2014985 STABMIXER
2081419 TABU
2111419 BUEGELTISCHBEZUG


Bestandsliste:


NAN Artikelbezeichnung Altbestand
0034557 BUEGELTISCH 370
1954656 KOMFORTSCHAUM MATRATZE 140X200CM 1.879
1348237 STABMIXER 4.588
1954662 KOMFORTSCHAUMMATRATZE 7-ZONEN 2.800
2014985 STABMIXER 4.274
2111419 BUEGELTISCHBEZUG 3.060
0998516 TERRASSENAUSSTECHER 7.200
1025428 SCHUESSELSET 10.100
1026294 VILEDA ULTRAMAT 719
1049697 GLITZI PUR ACTIVE 2+1 1.232
1049697 GLITZI PUR ACTIVE 2+1 8.064
1054479 HP 364 0
1062680 BESTECK IM KOFFER 60-TLG 3.571
1100291 STAUBSAUGERDEO 3.400
1106811 Akku-Rasentrimmer 2.406
1123421 KALTSCHAUM MATRATZE 7 ZONEN 352
1152702 PUZZLE 442
1158012 KUGELSCHREIBER 1.344




aber das ist schon eine riesige Hilfe.

Ich bedanke mich für deine Antwort.

MfG crunkfox