VBA voor in 2 verschillende bereiken te zoeken en van elkaar af te trekken

[tonissteiner]

Hallo,

ik zit vast met een code. ook via de record knop kom ik er niet uit.
Ik zit met 2 verschillende sheets waarin waarden staan. Het eerste blad is de algemene voorraad met een artikelnummer en het aantal ernaast.
In een tweede blad staan bepaalde artikelen die uit stock genomen zijn met het aantal dat uit stock genomen is.
Nu zou ik een knop "Verwerken" in het tweede blad willen zetten met een code er achter die gaat gaan zoeken in blad 2 welke en hoeveel artikelen en die in blad 1 gaat gaan aftrekken. Met nog een message box "Bent u zeker van de aantallen?".

Ben op zoek gegaan op dit forum en internet echter niks gevonden en ook niks waar ik met kan starten.

Hopelijk kan iemand me helpen of op weg zetten.

Alvast bedankt

mvg

PS. ik heb geen voorbeeldbestandje bijgevoegd omdat het mijn inzien vrij simpele data is die gemakkelijk na te bootsen is

 

[Cobbe]

En die moeten wij dan even voor u intypen?

 

[tonissteiner]

me op weg zetten...

 

[edmoor]

ik heb geen voorbeeldbestandje bijgevoegd omdat het mijn inzien vrij simpele data is die gemakkelijk na te bootsen is

Waarom dan niet zelf even een voorbeeld documentje plaatsen als het zo simpel is?

 

[tonissteiner]

ok, ik maak een voorbeeld en post het zo dadelijk.
Ik weet hoe ik moet zoeken in een blad. maar niet hoe ik de waarde van de kolom ernaast moet aftrekken van een artikel op een ander blad, waar ook moet gezocht worden naar een bepaald artikel en zijn aantal...
ben al lang bezig geweest te zoeken op dit forum om met iets van start te kunnen gaan. echter nog niks gevonden. vandaar mijn vraag of iemand me op weg kon helpen.
ik maak even een voorbeeldbestandje

 

[VenA]

Om mee te beginnen

Sub VenA()
ar = Sheets(1).Cells(1).CurrentRegion
With Sheets(2).Cells(1).CurrentRegion
    ar1 = .Value
        For j = 2 To UBound(ar1)
            For jj = 2 To UBound(ar)
                If ar(jj, 1) = ar1(j, 1) Then ar1(j, 2) = ar1(j, 2) - ar(jj, 2)
            Next jj
        Next j
    .Value = ar1
End With
End Sub

 

[tonissteiner]

bij deze het voorbeeldje...

 

[tonissteiner]

Bedankt VenA,

die ga ik eens analyseren en uitproberen. en erop verder proberen bouwen.

mvg

 

[VenA]

Heb ik toch bijna goed gegokt. Succes met het analyseren.

 

[tonissteiner]

Bedankt VenA

 

[VenA]

Graag gedaan. Als het werkt zoals je wil kan je de vraag op opgelost zetten.

 

[tonissteiner]

voorlopig heb ik je code nog niet kunnen bewerken zodat ze werkt, ik blijf proberen...

 

[VenA]

Hoewel het beter is om aan te geven waar je tegenaan loopt zal ik maar weer een gok doen.

Haal de eerste rij uit beide tabjes weg en probeer het dan nog eens. Of wijzig j = 2 in j = 3 idem voor jj En mogelijk ook sheets(1) en Sheets(2) omdraaien.

 

[tonissteiner]

Het lag inderdaad aan wat benamingen en cijfertjes dat het lag. De code werkt dus perfect. Zelfs als je per ongeluk een kleine letter zou gebruiken ipv een hoofdletter voor het artikel trekt hij deze niet af van het aantal in de algemene voorraad. De code werkt dus eigenlijk nog beter dan ik had gehoopt.

Met de message box zal ik wel alleen verder kunnen.

Nogmaals mijn dank VenA.

PS. Voor wie de code werkend wil zien, in bijlage het voorbeeldbestandje

Bekijk bijlage TonissteinerOK.xls

 

[VenA]

:thumb: Dat je het zelf hebt opgelost. Zelf zou ik nog iets inbouwen zodat er na de druk op de knop ook voor gezorgd wordt dat de gegevens in blad 'output' weer op 0 gezet worden. Anders wordt er mogelijk per abuis twee keer op de knop geklikt en dan klopt de voorraad niet meer.:d

 

[tonissteiner]

Goede morgen,

had het niet in mijn eerste bericht geschreven maar dat was ik eigenlijk ook van plan. Die code schrijven zal me wel lukken. Het was die andere waar jij mij mee geholpen hebt dat ik niet wist hoe aan te beginnen. Dus, nogmaals dank

 

[tonissteiner]

Het bestandje met message box en waarden die gewist worden. D
De code is niet zoals een echte programmeur die zou schrijven, echter samengesteld met kopiëren en plakken en gebruik van de macro recorder.
Maar ze werkt.
Wie weet kan ik er nog iemand plezier met doen...

Bekijk bijlage TonissteinerOK2.xls

 

[tonissteiner]

Hallo Terug,

ik moet mijn enthousiasme wat dempen. Wat ik niet vermeld had maar blijkbaar wel een rol speelt als ik deze code inbouw in mijn eigenlijk document is dat ik daar werk met een tabel. Met een specifieke opmaak dus. Echter zit er iets in de code waarmee de opmaak van de tabel in het blad "Database" verdwenen is na het uitvoeren van de code.

Ziet iemand waar het fout loopt in deze code?

Sub Data_verwerken()

Application.ScreenUpdating = False

    Dim Answer As Integer
    
        Sheets("Output").Unprotect
        Sheets("Database").Unprotect


        ar = Sheets("Output").Range("B4").CurrentRegion
        
    With Sheets("Database").Range("B4").CurrentRegion

            ar1 = .Value
                    Sheets("Output").Select
                    Application.ScreenUpdating = True
                    Answer = MsgBox("Zijn de aantallen juist?", vbYesNo + vbQuestion, "AANDACHT!")
                        If Answer = vbYes Then
                            For j = 2 To UBound(ar1)
                                For jj = 2 To UBound(ar)
                                    If ar(jj, 1) = ar1(j, 1) Then ar1(j, 4) = ar1(j, 4) - ar(jj, 3)
                                Next jj
                            Next j
                                .Value = ar1
                        Else
                            Sheets("Output").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                            ActiveSheet.EnableSelection = xlUnlockedCells
                            Sheets("Database").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                            ActiveSheet.EnableSelection = xlUnlockedCells
                            Exit Sub
                        
                        End If

    End With
    
        Application.ScreenUpdating = False
    
        'Gegevens wissen van blad "Output"
        Sheets("Output").Select
        Range("B4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
        Range("D4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents

        Range("D4").Select

        Sheets("Output").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveSheet.EnableSelection = xlUnlockedCells
        Sheets("Database").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveSheet.EnableSelection = xlUnlockedCells

        Sheets("Database").Select
    
Application.ScreenUpdating = True

End Sub

Ook nog even het bestand met de tabelopmaak

Bekijk bijlage Tonissteiner NOK.xls

Alvast bedankt

mvg

 

[snb]

Hoe doordachter de struktuur, hoe eenvoudiger de code.

 

[tonissteiner]

Hallo snb,

BEDANKT en knap gedaan. Begreep ik er maar wat meer van
Heb jouw code kunnen integreren in hetgeen ik al had:

Bekijk bijlage Tonissteiner OK3.xls

Prettige feesten aan iedereen

mvg