Goedemiddag,
Dit is de eerste post die ik op dit forum plaats, ik hoop dat ik geen overduidelijke regels overtreed
.
Situatie:
Ik heb een artikel bestand van een leverancier in 'Blad 2', heel veel artikelen. 30 tot 40k
* Kolom A - Bestel nummer (in mijn geval uniek referentie nummer)
* Kolom C - Bruto prijs
'Blad 1' is mijn artikel bestand wat ik gebruik, correcte omschrijvingen en nog meer zinvolle informatie voor mij.
* Kolom C - Bestel nummer (zelfde als Blad2:KolomA)
* Kolom H - Bruto prijs (zelfde als Blad2:KolomC)
Nu krijg ik elke maand een nieuwe artikel lijst met een update van de artikelen en prijs.
Deze wil ik vergelijken met mijn bruikbare lijst, 'Blad 1'.
Dus ik plak deze lijst in 'Blad 2' en pas onderstaande macro toe, die ik zelf heb gemaakt.
Hierin vergelijk ik de artikel nummers, als deze overeen komen, plakt hij de nieuwe bruto prijs achter de gebruikte kolommen in 'Blad 1', deze vergelijkt hij nogmaals met de eerder geplaatste bruto prijs, en zet hier een rode of groene kolom achter, zodat ik kan zien of deze gewijzigd is.
Hierna pas ik de prijs handmatig aan, (super weinig werk, ctrl C + ctrl V) zodat ik inzicht heb in de wijzigingen.
Deze formule werkt, alleen hij is te traag, als ik meer dan 100 artikelen op 'Blad 1' heb, doet hij er lang over, soms crasht hij.
Hij moet voor elke regel op blad 1, het totaal van blad 2 vergelijken.
Dit resulteert dat ik voor elke product groep een aparte Excel lijst heb gemaakt.
Kan iemand hier een efficiëntere formule van maken, indien mogelijk met een korte uitleg. Bij voorbaat dank!
...
Sub Prijsvergelijk()
Dim CompareRange As Variant, x As Variant, y As Variant, z As Variant, a As Variant, b As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set CompareRange = Worksheets("Blad2").Range("A2:A50000")
'CompareRange zijn de 'nieuwe' order nummers van Blad2, ik heb nu 50 000 gedaan als max. Als er dus meer dan 50k artikelen zijn moet deze omhoog
'De regel hierboven is de Selectie van de 'oude' order nummers op Blad1, hij pakt kolom C2 tot en met C'onderste'.
'Hieronder gaat hij dus de 'CompareRange' met de 'Selection' vergelijken, zijn deze gelijk dan.... bla bla zie hieronder.
For Each x In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
For Each y In CompareRange
If x = y Then
x.Offset(0, 14) = x 'dus als de Order nummer overeen komen, plakt hij het order nummer in 0,14
Set z = y.Offset(0, 2) 'hier maakt hij variable Z, de nieuwe bruto prijs. dus die kopiert hij van Y Ofset 0,2
x.Offset(0, 15) = z 'nu plakt hij Z, de nieuwe bruto prijs op 0,15 (dus achter X)
Set a = x.Offset(0, 5) 'hier zet hij variable A als de oude bruto prijs. (om hier onder weer te vergelijken)
If a = z Then 'Hij vergelijkt hier A(oude bruto prijs) met Z(nieuwe brutoprijs)
x.Offset(0, 16) = "1"
Else 'Voeg 1 of 0 toe op 0,16 (achter de nieuwe bruto prijs op blad1)
x.Offset(0, 16) = "0"
End If
If x.Offset(0, 16) = "1" Then
x.Offset(0, 16).Interior.Color = vbGreen
Else 'Maak 1 of 0 op 0,16(blad1) een kleurtje
x.Offset(0, 16).Interior.Color = vbRed
End If
End If
Next y
Next x
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Klaar !"
End Sub
...
Onderstaande, eerst uit te zetten in het begin van de macro, en op einde weer aan te zetten, weinig geholpen.
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
...
Dit is de eerste post die ik op dit forum plaats, ik hoop dat ik geen overduidelijke regels overtreed
.Situatie:
Ik heb een artikel bestand van een leverancier in 'Blad 2', heel veel artikelen. 30 tot 40k
* Kolom A - Bestel nummer (in mijn geval uniek referentie nummer)
* Kolom C - Bruto prijs
'Blad 1' is mijn artikel bestand wat ik gebruik, correcte omschrijvingen en nog meer zinvolle informatie voor mij.
* Kolom C - Bestel nummer (zelfde als Blad2:KolomA)
* Kolom H - Bruto prijs (zelfde als Blad2:KolomC)
Nu krijg ik elke maand een nieuwe artikel lijst met een update van de artikelen en prijs.
Deze wil ik vergelijken met mijn bruikbare lijst, 'Blad 1'.
Dus ik plak deze lijst in 'Blad 2' en pas onderstaande macro toe, die ik zelf heb gemaakt.
Hierin vergelijk ik de artikel nummers, als deze overeen komen, plakt hij de nieuwe bruto prijs achter de gebruikte kolommen in 'Blad 1', deze vergelijkt hij nogmaals met de eerder geplaatste bruto prijs, en zet hier een rode of groene kolom achter, zodat ik kan zien of deze gewijzigd is.
Hierna pas ik de prijs handmatig aan, (super weinig werk, ctrl C + ctrl V) zodat ik inzicht heb in de wijzigingen.
Deze formule werkt, alleen hij is te traag, als ik meer dan 100 artikelen op 'Blad 1' heb, doet hij er lang over, soms crasht hij.
Hij moet voor elke regel op blad 1, het totaal van blad 2 vergelijken.
Dit resulteert dat ik voor elke product groep een aparte Excel lijst heb gemaakt.
Kan iemand hier een efficiëntere formule van maken, indien mogelijk met een korte uitleg. Bij voorbaat dank!
...
Sub Prijsvergelijk()
Dim CompareRange As Variant, x As Variant, y As Variant, z As Variant, a As Variant, b As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set CompareRange = Worksheets("Blad2").Range("A2:A50000")
'CompareRange zijn de 'nieuwe' order nummers van Blad2, ik heb nu 50 000 gedaan als max. Als er dus meer dan 50k artikelen zijn moet deze omhoog
'De regel hierboven is de Selectie van de 'oude' order nummers op Blad1, hij pakt kolom C2 tot en met C'onderste'.
'Hieronder gaat hij dus de 'CompareRange' met de 'Selection' vergelijken, zijn deze gelijk dan.... bla bla zie hieronder.
For Each x In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
For Each y In CompareRange
If x = y Then
x.Offset(0, 14) = x 'dus als de Order nummer overeen komen, plakt hij het order nummer in 0,14
Set z = y.Offset(0, 2) 'hier maakt hij variable Z, de nieuwe bruto prijs. dus die kopiert hij van Y Ofset 0,2
x.Offset(0, 15) = z 'nu plakt hij Z, de nieuwe bruto prijs op 0,15 (dus achter X)
Set a = x.Offset(0, 5) 'hier zet hij variable A als de oude bruto prijs. (om hier onder weer te vergelijken)
If a = z Then 'Hij vergelijkt hier A(oude bruto prijs) met Z(nieuwe brutoprijs)
x.Offset(0, 16) = "1"
Else 'Voeg 1 of 0 toe op 0,16 (achter de nieuwe bruto prijs op blad1)
x.Offset(0, 16) = "0"
End If
If x.Offset(0, 16) = "1" Then
x.Offset(0, 16).Interior.Color = vbGreen
Else 'Maak 1 of 0 op 0,16(blad1) een kleurtje
x.Offset(0, 16).Interior.Color = vbRed
End If
End If
Next y
Next x
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Klaar !"
End Sub
...
Onderstaande, eerst uit te zetten in het begin van de macro, en op einde weer aan te zetten, weinig geholpen.
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
...
[ Voor 78% gewijzigd door Verwijderd op 04-07-2019 13:07 . Reden: Te vroeg, gepubliceerd, door TAB en Enter spam.. ]
/u/276077/cerberus.png?f=community)
