Listen Abgleichen Zugang-Abgang

Hi liebes Forum,
hab ein Problem, dass eigentlich nicht so schwer aussieht, aber irgendwie hab ich grad einen Black-Out...Habe eine Lagerliste, die wöchentlich erneuert wird, d.h. einige Artikel gehen zu, andere gehen ab. Um nicht alle restlichen Daten, die mit den Artikeln verbunden sind, wieder neu eingeben zu müssen und um Fehlerquellen möglichst ganz zu vermeiden, will ich dass Auffrischen der Liste über einen Vergleich machen. Sprich ich habe die alte Liste (Liste Vorwoche) und einen neue automatisch ermittelte Liste (Liste neue Woche). Nun will ich beide miteinander vergleichen und dem User auf je einem Sheet alle Artikel (identifizert anhand einer Artikelnummer) ausgeben, die
-gleich sind (also auf Liste altund neu stehen)
-neu sind (also nur auf der neuen Liste stehen)
-abgegangen sind (nur auf der alten Liste stehen).
Das ganze brauch ich in VBA, weil das nur ein Teil einer größeren Prozedur ist. Hab das ganze mit zwei For-Next-Schleifen versucht, aber irgendwie wird immer wieder alles überschrieben... File hängt an
https://www.herber.de/bbs/user/52054.xls
Danke!Florian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
probier mal das:


Sub Abgleich()
Dim rngLW As Range
Dim rngDW As Range
Dim Check As Integer
Dim Zelle As Range
With Sheets("ListeLetzteWoche")
Set rngLW = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With Sheets("ListeDieseWoche")
Set rngDW = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
With WorksheetFunction
For Each Zelle In rngLW
Check = .CountIf(rngLW, Zelle.Value) + .CountIf(rngDW, Zelle.Value)
Select Case Check
Case 1
Sheets("Abgleich").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = Zelle.Value
Case 2
Sheets("Abgleich").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Zelle.Value
End Select
Next
For Each Zelle In rngDW
If .CountIf(rngLW, Zelle.Value) = 0 Then
Sheets("Abgleich").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Zelle.Value
End If
Next
End With
End Sub

die Listen müssem allerdings eindeutig sein, dh. ein Artikel darf pro Liste nur 1x vorkommen.
Gruß, Daniel

Sub Abgleich() Dim rngLW As Range Dim rngDW As Range Dim Zelle As Range With Sheets("ListeLetzteWoche") Set rngLW = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) End With With Sheets("ListeDieseWoche") Set rngDW = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) End With With WorksheetFunction For Each Zelle In rngLW If .CountIf(rngDW, Zelle.Value) = 0 Then Sheets("Abgleich").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = Zelle.Value Else Sheets("Abgleich").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Zelle.Value End If Next For Each Zelle In rngDW If .CountIf(rngLW, Zelle.Value) = 0 Then Sheets("Abgleich").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Zelle.Value End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread