In 2 verschillende bereiken zoeken en van elkaar aftrekken, Verticaal zoeken probleem

[tonissteiner]

Hallo,

ik zit weer met een hoofdbrekertje. Met bijgevoegd bestand zal mijn uitleg alvast duidelijker zijn. Wat ik in dit bestand wil is van twee verschillende tabbladen de waarde van de één van de ander aftrekken. Met hulp van dit forum heb ik hier al een code voor gekregen. Mijn probleem begint echter wanneer ik een soort van verticaal zoeken in één van de tabellen inbouw. Bij het uitvoeren van de code worden de formules overschreven, maw de uitkomst wordt als tekst in de plaats gezet. Het zal misschien iets kleins zijn maar ik zie het niet. Iemand die het wel ziet?

Op tabblad "Database" wordt de voorraad bijgehouden en staat in kolom B de "verticaal zoeken" formule. Het zijn dus deze formules die "verdwijnen"
Op tabblad "Output" worden de aantallen ingevuld die uit voorraad genomen werden
Op tabblad "Items" wordt aan een artikel een artikel nummer gegeven

Bekijk bijlage In 2 verschillende bereiken zoeken en van elkaar aftrekken - versie 5.xls

Alvast bedankt voor jullie hulp

 

[Timshel]

Misschien zo:

Sub tsh()
    Dim i As Long
    Dim sn, sp, sq
    
    sn = Sheets("Database").ListObjects(1).DataBodyRange
    With Sheets("Output")
        .Unprotect
        With .ListObjects(1).DataBodyRange
            ReDim sq(UBound(sn) - 1)
            For i = 0 To UBound(sn) - 1
                sq(i) = sn(i + 1, 4) - Application.SumIf(.Columns(1), sn(i + 1, 1), .Columns(3))
            Next
            .Columns(1).ClearContents
            .Columns(3).ClearContents
        End With
        .Protect
    End With
    Sheets("Database").ListObjects(1).DataBodyRange.Columns(4) = Application.Transpose(sq)
End Sub

 

[tonissteiner]

Hallo Timshel,

bedankt voor je snelle reactie. Heb je code getest echter zelfde probleem. De formules in het bereik B4 t/m B9 van tabblad Database worden overschreven door hun uitkomsten...

 

[Timshel]

Nietes.

 

[tonissteiner]

Sorry, inderdaad ik was mis. waarschijnlijk iets verkeerd gedaan bij het testen. nog een aantal keren uitgeprobeerd en werkt feilloos. nog eens bedankt Timshel

 

[tonissteiner]

Heb de code proberen overbouwen in een masterdocument maar blijf toch problemen hebben. blijkbaar met de lijn

Sheets("Database").ListObjects(1).DataBodyRange.Columns(4) = Application.Transpose(sq)

Hoewel de code perfect werkt in het voorbeeldbestand wordt in het masterdocument de aantallen in een kolom ernaast gezet. en ook worden geen aantallen afgetrokken.

iemand?

 

[Timshel]

Kennelijk zijn er structuurverschillen tussen het voorbeeld en het masterdocument.
Om er iets van te kunnen zeggen hebben we een representatief voorbeeld nodig.

 

[tonissteiner]

die ben ik aan het proberen simuleren in een doorstuurbaar bestand. dacht dat het probleem lag bij benamingen van tabellen en bereiken. Echter als ik probeer deze te wijzigen in het masterdocument gebeurt er niks anders. ik ga verder proberen een representatief voorbeeld te maken

 

[tonissteiner]

Heb mijn masterdocument deftig opgekuist. en dus een representatief voorbeeld kunnen maken:

Bekijk bijlage In 2 verschillende bereiken zoeken en van elkaar aftrekken - versie 7.xlsm

 

[Timshel]

Deze regel moet je aanpassen:

Sheets("Stocklijst EGV Factory Electr.").ListObjects("MyGrid").DataBodyRange.Columns([COLOR="#FF0000"]5[/COLOR]) = Application.Transpose(sq)

Daarnaast is in beide tabellen de kolom 'Aantal' opgemaakt als tekst. Dan kan Excel er niet mee rekenen.
Maak de betreffende kolommen op als 'getal' en voer de waarden opnieuw in.

 

[tonissteiner]

Hallo Timshel,

die regel had ik al aangepast en je zal het misschien niet geloven maar zat juist mijn cellen aan te passen. het viel me ook op dat de celopmaak tekst was. maar ik was wel de verkeerde kolommen aan het aanpassen
en dus niet bij stilgestaan dat het de kolom aantal was die ik moest aanpassen.

werkt dus perfect nu.

nogmaals heel hartelijk mijn dank voor je hulp

mvg