Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.05.2024 23:36:08
IFNA Funktion in WENNNV übertragen
16.05.2024 19:31:55
Zellenfarbe beim.Filtern ändern
16.05.2024 19:29:08
Mit INDIREKT() auf andere Tabellenblätter referenzieren
16.05.2024 19:06:22
Monatssumme / Zahlweise / Kalenderjahr
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1948to1952
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
1948to1952
1948to1952
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Vergleich zweier Lagerbestände mit VBA

Vergleich zweier Lagerbestände mit VBA
25.10.2023 18:47:27
bigmayo
Moin zusammen,

ich habe mit dem folgenden Code ein Problem.

Er ist dafür da um den Lagerbestand auf zwei Tabellenblättern zu vergleichen.
Als Kriterium wird die Artikelnummer aus der jeweils ersten Spalte herangezogen.
Die Auswertung erfolgt auf einem dritten Blatt.
Dabei wird berücksichtigt das ein Artikel auf dem ersten Blatt auch in mehereren Zeilen vorkommen kann. (Lagerortbedingt)
Wenn ein Artikel auf einem der beiden Blätter komplett fehlt wird er mit entsprechender Differenz ausgegeben. (nix, also 0 zu Bestand auf dem anderen Blatt)
Anschließend wird die Differenz farbig hinterlegt.
Bevor sich der Code ausführt löscht er die Ausgabeseite. (Bis auf die Überschriften natürlich)

Jetzt das Problem. Bei manchen Artikeln funktioniert das nicht. Allerdings sporadisch und ohne erkennbares System. Es werden manchmal Artikel gleichzeitig mit Fehl- als auch Überbestand ausgegeben. Manchmal wird ein zweiter Lagerort auf dem ersten Blatt nicht berücksichtigt.

Hier der Code: 

Sub LagerbestandVergleich()

    Dim Blatt1 As Worksheet, Blatt2 As Worksheet, AusgabeBlatt As Worksheet

    Dim Zeile1 As Long, Zeile2 As Long, AusgabeZeile As Long

    Dim Artikel As String

    Dim BestandAufBlatt1 As Double

    Dim BestandAufBlatt2 As Double

    Dim Differenz As Double

    Dim ArtikelAufBlatt2 As Boolean

    Dim AggregierteArtikel As Object ' Verwenden Sie ein Dictionary

    Set AggregierteArtikel = CreateObject("Scripting.Dictionary")

    

    ' Definition der Arbeitsblätter (Blatt 1 und Blatt 2 sind die zu vergleichenden Blätter, AusgabeBlatt ist das dritte Blatt)

    Set Blatt1 = ThisWorkbook.Sheets("Inventur FG")

    Set Blatt2 = ThisWorkbook.Sheets("SGRE SAP")

    Set AusgabeBlatt = ThisWorkbook.Sheets("Inventurabgleich")

    

    ' Inhalt des Ausgabeblatts löschen (außer Überschriften)

    AusgabeBlatt.Rows("2:" & AusgabeBlatt.Rows.Count).Clear



    ' Anfangszeilen für die zu vergleichenden Blätter und das Ausgabeblatt

    Zeile1 = 2 ' Ändere dies entsprechend deiner Blattstruktur

    Zeile2 = 2 ' Ändere dies entsprechend deiner Blattstruktur

    AusgabeZeile = 2 ' Ändere dies entsprechend deiner Blattstruktur



    ' Variablen

    Artikel = ""

    BestandAufBlatt1 = 0

    BestandAufBlatt2 = 0

    ArtikelAufBlatt2 = False



    ' Aggregiere die Artikelbestände Zeile für Zeile von Blatt1

    Do While Blatt1.Cells(Zeile1, 1).Value > ""

        Artikel = Blatt1.Cells(Zeile1, 1).Value

        BestandAufBlatt1 = 0

        ArtikelAufBlatt2 = False



        ' Überprüfung ob der Artikel bereits im Dictionary vorhanden ist

        If AggregierteArtikel.Exists(Artikel) Then

            BestandAufBlatt1 = AggregierteArtikel(Artikel)

        End If



        ' Aggregiere den Bestand für den Artikel auf Blatt1

        Do

            BestandAufBlatt1 = BestandAufBlatt1 + Blatt1.Cells(Zeile1, 6).Value

            Zeile1 = Zeile1 + 1

        Loop While Blatt1.Cells(Zeile1, 1).Value = Artikel

        

        AggregierteArtikel(Artikel) = BestandAufBlatt1



        ' Artikelsuche auf Blatt2

        ArtikelAufBlatt2 = False

        BestandAufBlatt2 = 0 ' Zurücksetzen des Bestands auf Blatt2



        For Zeile2 = 2 To Blatt2.Cells(Rows.Count, 1).End(xlUp).Row

            If Blatt2.Cells(Zeile2, 1).Value = Artikel Then

                ArtikelAufBlatt2 = True

                BestandAufBlatt2 = Blatt2.Cells(Zeile2, 2).Value

                Exit For

            End If

        Next Zeile2



        ' Berechnung der Differenz, Daten ins Ausgabeblatt schreiben

        Differenz = BestandAufBlatt1 - BestandAufBlatt2



        ' Berechnung der Differenz, Daten ins Ausgabeblatt schreiben

        If Differenz > 0 Then

            ' Überprüfung ob der Artikel bereits in der Ausgabe existiert

            If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                AusgabeBlatt.Cells(AusgabeZeile, 2).Value = Blatt1.Cells(Zeile1, 2).Value

                AusgabeBlatt.Cells(AusgabeZeile, 3).Value = BestandAufBlatt1

                AusgabeBlatt.Cells(AusgabeZeile, 4).Value = BestandAufBlatt2

                AusgabeBlatt.Cells(AusgabeZeile, 5).Value = Differenz



                ' Formatierung basierend auf der Differenz

                If Differenz  0 Then

                    AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192) ' Hellrot

                ElseIf Differenz > 0 Then

                    AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(192, 255, 192) ' Hellgrün

                End If



                AusgabeZeile = AusgabeZeile + 1

            End If

        End If



        ' Wenn der Artikel auf Blatt1 nicht auf Blatt2 gefunden wurde, zeige dies als Fehlbestand an

        If Not ArtikelAufBlatt2 Then

            ' Überprüfung ob der Artikel bereits in der Ausgabe existiert

            If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                AusgabeBlatt.Cells(AusgabeZeile, 2).Value = Blatt1.Cells(Zeile1, 2).Value

                AusgabeBlatt.Cells(AusgabeZeile, 3).Value = BestandAufBlatt1

                AusgabeBlatt.Cells(AusgabeZeile, 4).Value = ""

                AusgabeBlatt.Cells(AusgabeZeile, 5).Value = Differenz



                ' Zeile markieren wenn Unterschied

                AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192) ' Hellrot



                AusgabeZeile = AusgabeZeile + 1

            End If

        End If

    Loop



    ' Überprüfung ob es noch Artikel auf Blatt2 gibt, die nicht auf Blatt1 gefunden wurden

    For Zeile2 = 2 To Blatt2.Cells(Rows.Count, 1).End(xlUp).Row

        Artikel = Blatt2.Cells(Zeile2, 1).Value

        BestandAufBlatt2 = Blatt2.Cells(Zeile2, 2).Value



        ' Suche den Artikel in den aggregierten Artikeln auf Blatt1

        If Not AggregierteArtikel.Exists(Artikel) Then

            ' Überprüfung ob der Artikel bereits in der Ausgabe existiert

            If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                AusgabeBlatt.Cells(AusgabeZeile, 2).Value = ""

                AusgabeBlatt.Cells(AusgabeZeile, 3).Value = 0

                AusgabeBlatt.Cells(AusgabeZeile, 4).Value = BestandAufBlatt2

                AusgabeBlatt.Cells(AusgabeZeile, 5).Value = -BestandAufBlatt2



                ' Zeile markieren wenn Unterschied

                AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192) ' Hellrot



                AusgabeZeile = AusgabeZeile + 1

            End If

        End If

    Next Zeile2



End Sub



Function ArtikelExistiertInAusgabe(AusgabeBlatt As Worksheet, Artikel As String, Differenz As Double) As Boolean

    Dim Zeile As Long

    ArtikelExistiertInAusgabe = False

    For Zeile = 2 To AusgabeBlatt.Cells(Rows.Count, 1).End(xlUp).Row

        If AusgabeBlatt.Cells(Zeile, 1).Value = Artikel Then

            ' Der Artikel existiert bereits in der Ausgabe

            ArtikelExistiertInAusgabe = True

            ' Aktualisierung vom Ausgabetext und Formatierung

            AusgabeBlatt.Cells(Zeile, 5).Value = Differenz

            If Differenz  0 Then

                AusgabeBlatt.Cells(Zeile, 5).Interior.Color = RGB(255, 192, 192) ' Hellrot

            ElseIf Differenz > 0 Then

                AusgabeBlatt.Cells(Zeile, 5).Interior.Color = RGB(192, 255, 192) ' Hellgrün

            End If

            Exit Function

        End If

    Next Zeile

End Function


Ich hoffe ihr könnt mir helfen. Es kann gut sein das ich den Wald vor lauter Bäumen nicht mehr sehe.

Gruß

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

Betreff
Datum
Anwender
Anzeige
AW: Vergleich zweier Lagerbestände mit VBA
25.10.2023 22:30:11
Yal
Hallo Big (man spricht sich im Forum per Vornamen an ;-) Dafür ist ein Nick, der nicht jeder hat, sehr gut )

Ich habe zuerst angefangen, den "Fehler" zu suchen und dann gedacht, es wäre schneller, einen Code vorzuschlagen.
Ich empfehle die Bibliothek anzubinden, anstatt "CreateObject" zu verwenden. Es sei denn, es ist ein Code, der immer aufs neu Copy-Pasted wird. Die Vorteile: IntelliSense, ObjektKatalog, genauere Kompilierungsprüfung (Alt+g, k). 

Sub Bestand_vergleichen()

'unter Anbindung ("Extras", "Verweise...") der Bibliothek:

'Microsoft Scripting Runtime

Dim Best1 As New Dictionary 'aus der angebundene Bibliothek

Dim Best2 As New Dictionary

Dim K 'K wie Key



    Bestand_lesen "Inventur FG", Best1

    Bestand_lesen "SGRE SAP", Best2

    

    With ThisWorkbook.Sheets("Inventurabgleich")

        For Each K In Best1.Keys

            With .Cells(Rows.Count, 1).End(xlUp)

                .Offset(1, 0).Value = K 'Artikel

                .Offset(1, 1).Value = Best1(K) 'Bestand Blatt 1

                .Offset(1, 2).Value = 0 'Default value, sonst müsste man einen "Else" darunter hinzufügen

                If Best2.Exists(K) Then

                    .Offset(1, 2).Value = Best2(K)

                    Best2(K) = 0 'Reset für die zweite Schleife

                End If

                .Offset(1, 3).Value = .Offset(1, 2).Value - .Offset(1, 3).Value

            End With

        Next

        For Each K In Best2

            If Best2(K) > 0 Then 'also alle, die in Best1 nicht gefunden wurden

                With .Cells(Rows.Count, 1).End(xlUp)

                    .Offset(1, 0).Value = K 'Artikel

                    .Offset(1, 1).Value = 0

                    .Offset(1, 2).Value = Best2(K)

                    .Offset(1, 3).Value = -Best2(K)

                End With

            End If

        Next

    End With

End Sub



Sub Bestand_lesen(Blattname As String, Dic As Dictionary, Optional StartZeile = 2)

Dim R As Long 'R wie Row

    With ThisWorkbook.Worksheets(Blattname)

        R = StartZeile

        Do While .Cells(R, 1).Value > "" 

            Dic(.Cells(R, 1).Value) = Dic(.Cells(R, 1).Value) + .Cells(R, 6).Value

            R = R + 1

        Loop

    End With

End Sub

Der Code ist ungetestet, da die Datei nachzubauen ein erheblicher Aufwand ist (und wahrscheinlich nicht passend zum Original).

VG
Yal
Anzeige
Ach...
25.10.2023 22:54:32
Yal
Hallo Big,

vielleicht habe ich doch falsch verstanden: herausgegeben wird nur, wenn eine Bestandsunterschied vorliegt.
Dann wie folgt: 

Sub Bestand_vergleichen()

'unter Anbindung ("Extras", "Verweise...") der Bibliothek:

'Microsoft Scripting Runtime

Dim Best1 As New Dictionary 'aus der angebundene Bibliothek

Dim Best2 As New Dictionary

Dim K 'K wie Key



    Bestand_lesen "Inventur FG", Best1

    Bestand_lesen "SGRE SAP", Best2

'für die Artikel von Blatt1

    For Each K In Best1.Keys

        If Best2.Exists(K) Then

            If Best1(K) > Best2(K) Then Bestände_ausgeben K, Best1(K), Best2(K) 'nur bei Ungleicheit

            Best2(K) = 0 'Reset für die zweite Schleife

        Else

            Bestände_ausgeben K, Best1(K), 0

        End If

    Next

'für die Artikel von Blatt2, die nicht Blatt1 vorhanden waren

    For Each K In Best2

        If Best2(K) > 0 Then Bestände_ausgeben K, 0, Best2(K)

    Next

End Sub



Sub Bestand_lesen(Blattname As String, Dic As Dictionary, Optional StartZeile = 2)

Dim R As Long 'R wie Row

    With ThisWorkbook.Worksheets(Blattname)

        R = StartZeile

        Do While .Cells(R, 1).Value > ""

            Dic(.Cells(R, 1).Value) = Dic(.Cells(R, 1).Value) + .Cells(R, 6).Value

            R = R + 1

        Loop

    End With

End Sub



Sub Bestände_ausgeben(ByVal Artikel As String, Bestand1 As Double, Bestand2 As Double)

    With ThisWorkbook.Sheets("Inventurabgleich").Cells(Rows.Count, 1).End(xlUp)

        .Offset(1, 0).Value = Artikel

        .Offset(1, 1).Value = Bestand1

        .Offset(1, 2).Value = Bestand2

        .Offset(1, 3).Value = Bestand1 - Bestand2

    End With

End Sub

Ich habe die Ausgabe in einer separaten Sub abgelagert, weil diese 3mal gerufen wird. 3mal den gleichen Code wäre absurd.

VG
Yal
Anzeige
AW: Ach...
26.10.2023 08:36:01
bigmayo
Moin Yal,

das ist elegant geschriebener Code. Allerdings fehlen die von mir dringend benötigten Grundfunktionen wie aggregation der Artikel auf Blatt1, Löschung das Ausgabeblattes vor Ausgabe, Formatierung, etc.
Ich denke das vor allem die verstreuten Artikel auf Blatt1 eine Herausforderung sind.

Hier ein Beispiel wie die beiden Listen aussehen: 

Teilenummer	Bezeichnung	Zähl- Menge

10000	AAA	15

10001	BBB	10

10002	CCC	30

10003	DDD	10

10003	DDD	10

10003	DDD	10

10004	EEE	30

10005	FFF	30

10006	GGG	30

10001	BBB	20

10007	HHH	30

10008	III	5

10008	III	5

10008	III	10

10008	III	10

10009	JJJ	30

10010	KKK	30

10011	LLL	30

10012	MMM	30

10013	NNN	30

10000	AAA	15



Teilenummer	Bezeichnung	Zähl- Menge

10000	AAA	30

10001	BBB	30

10002	CCC	30

10003	DDD	30

10004	EEE	30

10005	FFF	30

10006	GGG	30

10007	HHH	30

10008	III	30

10009	JJJ	30

10010	KKK	30

10011	LLL	30

10012	MMM	30

10013	NNN	30
Anzeige
AW: Ach...
26.10.2023 09:10:17
bigmayo
Moin,

ich habe den Fehler gefunden. Die Krux war die von mir verwendete Schleife. Dadurch wurden Änderungen nicht korrekt verarbeitet.

Hier der verbesserte Code: 

Sub LagerbestandVergleich()

    Dim Blatt1 As Worksheet, Blatt2 As Worksheet, AusgabeBlatt As Worksheet

    Dim Zeile1 As Long, Zeile2 As Long, AusgabeZeile As Long

    Dim Artikel As String

    Dim BestandAufBlatt1 As Double

    Dim BestandAufBlatt2 As Double

    Dim Differenz As Double

    Dim ArtikelAufBlatt2 As Boolean

    Dim AggregierteArtikel As Object ' Verwenden Sie ein Dictionary

    Set AggregierteArtikel = CreateObject("Scripting.Dictionary")

    

    Set Blatt1 = ThisWorkbook.Sheets("Inventur 1")

    Set Blatt2 = ThisWorkbook.Sheets("Inventur 2")

    Set AusgabeBlatt = ThisWorkbook.Sheets("Inventurabgleich")

    

    AusgabeBlatt.Rows("2:" & AusgabeBlatt.Rows.Count).Clear



    Zeile1 = 2

    Zeile2 = 2

    AusgabeZeile = 2



    Artikel = ""

    BestandAufBlatt1 = 0

    BestandAufBlatt2 = 0

    ArtikelAufBlatt2 = False



    Do While Blatt2.Cells(Zeile2, 1).Value > ""

        Artikel = Blatt2.Cells(Zeile2, 1).Value

        BestandAufBlatt2 = Blatt2.Cells(Zeile2, 2).Value



        ArtikelAufBlatt2 = False

        BestandAufBlatt1 = 0



        For Zeile1 = 2 To Blatt1.Cells(Rows.Count, 1).End(xlUp).Row

            If Blatt1.Cells(Zeile1, 1).Value = Artikel Then

                ArtikelAufBlatt2 = True

                BestandAufBlatt1 = BestandAufBlatt1 + Blatt1.Cells(Zeile1, 6).Value

            End If

        Next Zeile1



        Differenz = BestandAufBlatt1 - BestandAufBlatt2



        If Differenz > 0 Then

            If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                AusgabeBlatt.Cells(AusgabeZeile, 2).Value = Blatt1.Cells(Zeile1, 2).Value

                AusgabeBlatt.Cells(AusgabeZeile, 3).Value = BestandAufBlatt1

                AusgabeBlatt.Cells(AusgabeZeile, 4).Value = BestandAufBlatt2

                AusgabeBlatt.Cells(AusgabeZeile, 5).Value = Differenz



                If Differenz  0 Then

                    AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192)

                ElseIf Differenz > 0 Then

                    AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(192, 255, 192)

                End If



                AusgabeZeile = AusgabeZeile + 1

            End If

        End If



        If Not ArtikelAufBlatt2 Then

            If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                AusgabeBlatt.Cells(AusgabeZeile, 2).Value = Blatt1.Cells(Zeile1, 2).Value

                AusgabeBlatt.Cells(AusgabeZeile, 3).Value = BestandAufBlatt1

                AusgabeBlatt.Cells(AusgabeZeile, 4).Value = ""

                AusgabeBlatt.Cells(AusgabeZeile, 5).Value = Differenz



                AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192)



                AusgabeZeile = AusgabeZeile + 1

            End If

        End If



        Zeile2 = Zeile2 + 1

    Loop



    For Zeile1 = 2 To Blatt1.Cells(Rows.Count, 1).End(xlUp).Row

        Artikel = Blatt1.Cells(Zeile1, 1).Value

        BestandAufBlatt1 = 0

        

        ArtikelAufBlatt2 = False

        BestandAufBlatt2 = 0



        For Zeile2 = 2 To Blatt2.Cells(Rows.Count, 1).End(xlUp).Row

            If Blatt2.Cells(Zeile2, 1).Value = Artikel Then

                ArtikelAufBlatt2 = True

                BestandAufBlatt2 = Blatt2.Cells(Zeile2, 2).Value

            End If

        Next Zeile2



        If Not ArtikelAufBlatt2 Then

            Differenz = BestandAufBlatt1 - BestandAufBlatt2



            If Differenz > 0 Then

                If Not ArtikelExistiertInAusgabe(AusgabeBlatt, Artikel, Differenz) Then

                    AusgabeBlatt.Cells(AusgabeZeile, 1).Value = Artikel

                    AusgabeBlatt.Cells(AusgabeZeile, 2).Value = Blatt1.Cells(Zeile1, 2).Value

                    AusgabeBlatt.Cells(AusgabeZeile, 3).Value = BestandAufBlatt1

                    AusgabeBlatt.Cells(AusgabeZeile, 4).Value = BestandAufBlatt2

                    AusgabeBlatt.Cells(AusgabeZeile, 5).Value = Differenz



                    If Differenz  0 Then

                        AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(255, 192, 192)

                    ElseIf Differenz > 0 Then

                        AusgabeBlatt.Cells(AusgabeZeile, 5).Interior.Color = RGB(192, 255, 192)

                    End If



                    AusgabeZeile = AusgabeZeile + 1

                End If

            End If

        End If



        Zeile1 = Zeile1 + 1

    Next Zeile1



End Sub



Function ArtikelExistiertInAusgabe(AusgabeBlatt As Worksheet, Artikel As String, Differenz As Double) As Boolean

    Dim Zeile As Long

    ArtikelExistiertInAusgabe = False

    For Zeile = 2 To AusgabeBlatt.Cells(Rows.Count, 1).End(xlUp).Row

        If AusgabeBlatt.Cells(Zeile, 1).Value = Artikel Then

            ArtikelExistiertInAusgabe = True

            AusgabeBlatt.Cells(Zeile, 5).Value = Differenz

            If Differenz  0 Then

                AusgabeBlatt.Cells(Zeile, 5).Interior.Color = RGB(255, 192, 192)

            ElseIf Differenz > 0 Then

                AusgabeBlatt.Cells(Zeile, 5).Interior.Color = RGB(192, 255, 192)

            End If

            Exit Function

        End If

    Next Zeile

End Function


Gruß
Anzeige
AW: Ach...
26.10.2023 10:05:50
Yal
Moin,

ich hatte mich natürlich auf das wesentlichen beschränkt.

Das Löschen im Zielblatt bezieht sich auf einer einzigen Code-Zeile: 
 AusgabeBlatt.Rows("2:" & AusgabeBlatt.Rows.Count).Clear
Ich bin durchaus der Meinung, dass mit der Selbsteinschätzung "VBA gut" dies von Dir erkannt wurde und in der Lage bist, diese Zeile nachzutragen.

Die Aggregation ist auch drin, wenn auch nur für geübte Auge: ein Dictionary sammelt Information in einer Liste, bei der jede Element eindeutig ist. Mit 
Dic(.Cells(R, 1).Value) = Dic(.Cells(R, 1).Value) + .Cells(R, 6).Value
wird ein Element aus Spalte 1 (Artikel) aus der Liste genommen und der Wert aus Spalte 6 addiert. Ist noch kein Element da, wird das Element mit dem Basiswert null erzeugt, dann Bestand adddiert.

Aber diese Tatsache hast Du natürlich bei Ausführen des Codes entdeckt.

Das "schön machen" und sonstige Farbvergabe wirst Du sicher schnell in Griff haben. Ich würde in dem Fall mit bedingter Formatierung arbeiten anstatt feste Farbfestlegen Zelle für Zelle anzulegen.

VG
Yal
Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige