cellen vergelijken, als gelijk dan celwaarde verminderen met 1

[balkumj]

Voor wie dit leest, Hallo,

Ik wil graag een macro maken die onze voorraad bijhoud. Ik heb een lijst met artikelen die ik een vaste barcode geef. Als iemand van de voorraad pakt dan moet het artikel gescand worden. Als de scanner wordt uitgelezen komen de barcodes in Excel te staan. Dus als bv er 10 artikelen zijn dan heb ik max 10 verschillende barcodes die tig keer gescand zijn.

Het is de bedoeling dat die ingelezen barcodes worden vergeleken met de standaard barcodes. Als er een gevonden wordt dan moet er 2 kolommen verder de voorraad met 1 verminderd worden.

Ik heb al gegoogled en kwam wel met iets om de barcodes te vergelijken, maar ik krijg het niet voor elkaar dat de celwaarde met 1 wordt verminderd. Dit is wat ik heb voor de vergelijking:

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant


' Stel CompareRange in op het bereik waarmee u de selectie wilt vergelijken.
Set CompareRange = Range("C1:C5")
' Opmerking Als het vergelijkingsbereik zich in een andere werkmap of een ander werkbalk bevindt, gebruikt u de volgende syntaxis.
' Set CompareRange = Workbooks("Book2"). _
' Worksheets("Sheet2").Range("C1:C5")
'
' Doorloop elke cel in de selectie en vergelijk deze met
' elke cel in CompareRange.
For Each x In Selection
For Each y In CompareRange
If x = y Then y.Offset(0, 2) = x
Next y
Next x
End Sub

Hij zet nu de x waarde keurig in 2 cellen verder.

Ik heb vervolgens geprobeerd om de x te vervangen: If x = y Then x.Offset(0, 4) = (ActiveCell.Value - 1)
Of door erbij te zetten: c = ActiveCell.Value en dan If x = y Then x.Offset(0, 4) = c - 1

Maar niets werkt. Ik krijg of foutmeldingen (type mismatch vaak) of de waarde in de cel wordt -1.

Kan iemand mij helpen?

Groetjes Jolanda

 

[Timshel]

2 dingen:
Plaats graag een voorbeeldbestand.
Zet code tussen codetage (#).

 

[Leotaxi]

kun je met deze verder ?

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant

' Stel CompareRange in op het bereik waarmee u de selectie wilt vergelijken.
Set CompareRange = Range("A1:A5")

For Each x In Selection
For Each y In CompareRange
If x = y Then
Range("C" & y.Row).Value = Range("C" & y.Row).Value - 1
End If
Next y
Next x

End Sub

mvg
Leo

 

[balkumj]

Hoi Timshel; Hierbij de bijlage en de macro tussen #. Ik hoop dat ik het goed heb gedaan en dat het nu duidelijker wordt.
Hoi Leotaxi; Ik krijg een error 13 met type mismatch op deze regel:

Range("C" & y.Row).Value = Range("C" & y.Row).Value - 1

Hij zet nu dus wel de waarde (is de barcode) in de cel waar naar verwezen wordt. Wat ik wil is dat bij de voorraad er 1 verminderd wordt op die regel. En als het zou kunnen tot een minimum van 0 omdat er toch geen negatieve waarden in het magazijn liggen.

Bekijk bijlage voorraden scanner test.xlsm

Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    
    ' Stel CompareRange in op het bereik waarmee u de selectie
    ' wilt vergelijken.
   Set CompareRange = Range("C2:C7")
    ' Opmerking Als het vergelijkingsbereik zich in een andere werkmap
    ' of een ander werkbalk bevindt, gebruikt u de volgende syntaxis.
    ' Set CompareRange = Workbooks("Book2"). _
    '   Worksheets("Sheet2").Range("C1:C5")
    '
    ' Doorloop elke cel in de selectie en vergelijk deze met
    ' elke cel in CompareRange.
    For Each x In Selection
        For Each y In CompareRange
           
       If x = y Then y.Offset(0, 5) = x
            'ActiveCell.Value 1 ActiveCell.Offset --> werkt niet
            'If x = y Then x.Offset(0, 4) = (ActiveCell.Value - 1) --> werkt niet
        Next y
    Next x
 End Sub

Alvast bedankt voor de hulp.

Groetjes Jolanda

 

[balkumj]

Sorry Leotaxi,

Jouw code werkte wel!!! Ik moest alleen de kolom "C" in "E" veranderen.

Nog 1 klein vraagje: Kan er ook nog iets bij dat de voorraad niet lager wordt dan 0? Hij hoeft geen foutmelding te geven als de macro een negatief antwoord genereerd. Ik weet niet of dat mogelijk is?
Als het niet kan is het ook niet erg hoor.

Ik ben hier al heel blij mee.

 

[Leotaxi]

verander dit

If x = y Then
Range("E" & y.Row).Value = Range("E" & y.Row).Value - 1
End If

naar

If x = y and Range("E" & y.Row).Value > 0 Then
Range("E" & y.Row).Value = Range("E" & y.Row).Value - 1
End If

mvg
Leo

 

[balkumj]

Helemaal goed!!!!!

Ik ga nu weer verder spelen op andere onderdelen van mijn voorraadbestandje.
Ik zal dit topic sluiten en mocht het nodig zijn een ander openen.

Hartelijk dank voor de hulp.

Groetjes Jolanda

 

[balkumj]

ehmm, als ik weet hoe. Eens kijken...

Nee helaas, ook hier heb ik wat hulp nodig. Kan ik een topic zelf sluiten of doet een moderator dit?

 

[Leotaxi]

ergens rechts bovenaan staat de status van de vraag,enkel jij kan die wijzigen

mvg
Leo

 

[balkumj]

gevonden, denk ik. Weer bedankt