Voorraad aantallen aanpassen o.b.v. een factuur in vba

Status
Niet open voor verdere reacties.
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Forumleden,

Graag zou ik voor een administratiepakket, in één handeling, een voorraadlijst willen muteren op basis van de gegevens vanuit een factuur (zie bijlage).

Op de factuur staan in de regels 20 t/m 51 in kolom C de aantallen en in kolom E de omschrijving. Nu zou ik graag dat het systeem zoekt op omschrijving in werkblad "Factuur" en de aantallen (kol. C) overneemt in kolom I (totaal verkocht) van het werkblad "Tarieven", maar omdat hier al een getal in kan staan, is het de bedoeling dat het aantal wordt opgeplust.

Verder kan het voorkomen dat er ook omschrijvingen in de factuur staan die niet voorkomen in de voorraadlijst (Tarieven), deze dient het systeem dan over te slaan.

Ik zit zelf te denken in de richting van:
Code: 
Sub Voorraadaanpassen()
With Sheets("Factuur")
    For Each cl In .Range("E20:E51" & .Cells(Rows.Count, 2).End(xlUp).Row)
        Set fnumber = Sheets("Tarieven").Columns(2).Find(cl, , xlValues, xlWhole)
        If Not fnumber Is Nothing Then fnumber.???
    Next
End With
End Sub

Alvast heel hartelijk dank.

Robert
 

Bijlagen

  • Voorraad aanpassen.xlsm
    84,7 KB · Weergaven: 25
Laatst bewerkt:
Maak de tabel niet groter dan nodig.
Code: 
Sub Voorraadaanpassen_hsv()
Dim sv, sv2, i As Long
sv = Sheets("factuur").Range("c20:e50")
sv2 = Sheets("tarieven").ListObjects(1).DataBodyRange
    With CreateObject("scripting.dictionary")
      For i = 1 To UBound(sv)
         .Item(sv(i, 3)) = .Item(sv(i, 3)) + sv(i, 1)
      Next i
        For i = 1 To UBound(sv2)
          If sv2(i, 1) <> "" Then sv2(i, 9) = sv2(i, 9) + .Item(sv2(i, 2))
        Next i
      End With
  Sheets("tarieven").ListObjects(1).DataBodyRange = sv2
End Sub
 
Hier was ik zelf nooit opgekomen, heel erg bedankt...werkt weer eens perfect. :thumb:
 
Beste Harry of ander forumlid,

Onlangs heb jij (HSV) mij ontzettend goed geholpen met een vba-code. Ik heb hier nog een aanvullend verzoek op.

De code zorgt ervoor dat wanneer het product voorkomt in werkblad "Tarieven" én in werkblad "Factuur" dat het systeem de aantallen vanuit werkblad "Factuur" van het betreffende product optelt in werkblad "Tarieven". Nu komt het ook voor dat het zoekitem vanuit werkblad "Factuur" niet altijd voorkomt in werkblad "Tarieven", op dit moment en zoals aanvankelijk was bedoeld doet het systeem daar niets mee.

Mijn verzoek is dat wanneer het artikel niet voorkomt in werkblad Tarieven, maar wél wordt genoemd op de factuur, het systeem dit optelt onder "Overige opbrengsten". In het bijgevoegde voorbeeld staat een artikel op de factuur maar komt niet voor in werkblad "Tarieven". Het zou voor mij ideaal zijn dat dit onder "Overige opbrengsten" opgeteld wordt.

Alvast heel erg bedankt.

Robert
 

Bijlagen

  • Voorraad aanpassen.xlsm
    88,5 KB · Weergaven: 26
Code: 
Sub Voorraadaanpassen()
Dim sv, sv2, m, i As Long
sv = Sheets("factuur").Range("c20:e50")
sv2 = Sheets("tarieven").ListObjects(1).DataBodyRange
    With CreateObject("scripting.dictionary")
      For i = 1 To UBound(sv)
      m = Application.Match(sv(i, 3), Application.Index(sv2, 0, 2), 0)
      If IsNumeric(m) Then
         .Item(sv(i, 3)) = .Item(sv(i, 3)) + sv(i, 1)
       Else
         .Item("Overige opbrengsten") = .Item("Overige opbrengsten") + sv(i, 1)
      End If
      Next i
        For i = 1 To UBound(sv2)
          If sv2(i, 1) <> "" Then sv2(i, 9) = sv2(i, 9) + .Item(sv2(i, 2))
        Next i
      End With
  Sheets("tarieven").ListObjects(1).DataBodyRange = sv2
End Sub
 
Heel erg bedankt Harry, ik heb het getest en dit werkt uitstekend :thumb:...Ik ga hier nog even verder mee testen en nogmaals heel erg bedankt voor de snelle reactie en nog een fijne zondag.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan