VBA - elegantere code om prijsafspraken vast te leggen gezocht

[Wezenspyk]

Beste allen,
Ik heb een programma geschreven waarmee ik, oa, prijsafspraken van klanten wil vastleggen.
Zie bijgevoegd een voorbeeld van een stukje van het programma.

Wat wil ik bereiken?
De code werkt op zich wel, maar is erg omslachtig. Voor een groter aantal regels en wijzigingen, duurt het enkele minuten voordat de macro volledig is uitgevoerd.
Ik heb het vermoeden dat deze hele code een stuk eleganter en efficienter kan worden geschreven.

Hoe is de code geschreven?
1. Ga naar sheet Artikelen, en verwijder alle kolommen vanaf kolom C. Deze regel is geschreven om er voor te zorgen dat eventuele wijzigingen in kolom C van tabblad 'Prijsafspraken' goed te registreren. De lijst in tabblad 'Prijsafspraken' is altijd een geupdate lijst, en deze kunnen wijzigen.

2. Loop door Debiteuren heen en controleer of er een prijsafspraak is vastgelegd of niet. In het originele bestand heb ik een formule staan in kolom C van Debiteuren. Als er een naam wordt toegevoegd in tabblad 'Prijsafspraken' (oftewel, er is voor een klant een prijsafspraak vastgelegd), dan verandert de waarde in kolom C van 'Debiteuren' naar "Ja"

3. Kopieer de naam van de klant met de prijsafspraak naar een nieuwe kolom in tabblad Artikelen.

4. Plant een formule in deze nieuwe kolom in de tweede regel. Deze formule is een index match met twee criteria. Om een link te maken tussen de prijsafspraak, de naam van de klant en het artikel. Omdat het een tabel betreft, wordt de formule automatisch doorgetrokken naar de laatste regel in de tabel.

5. Op 1 of andere manier wordt de index-match formule aangepast als ik hem plaats. Er worden twee '@' tekens in de formule gevoegd zodat deze geen resultaten geeft. Om dit tegen te gaan heb ik regels toegeveogd om in de range alle '@' te vinden en te vervangen door niks "". Als er een match is tussen naam klant en een artikel, moet de vastgelegde prijsafspraak in de tabel komen. Als er geen match is, dan moet de cell voor dat artikel voor die klant leeg blijven.

6. Er staan nu allemaal formules in de tabel die de boel flink vertragen. Daarom heb ik vervolgens een code geschreven die alle formules omzet naar waarden.

Zoals gezegd. Hij doet het wel, maar is erg traag omdat ik te maken heb met 100-en artikelen en 100-en afnemers met prijsafspraken. Deze code werkt daarom erg traag. Ik weet bijna zeker dat hij sneller en beter kan.

Samenvattend doel:
Ik wil dat de prijsafspraken, zoals gevonden in Tabblad Prijsafspraken, gekoppeld worden aan artikelen per afnemer. Tabblad Prijsafspraken kunnen wijzigingen. Hier moet de code rekening mee houden.

Wie helpt me uit de brand?
Ik hoor graag als er vragen of onduidelijkheden zijn!

 

[edmoor]

Er zit geen code in je document.

 

[Wezenspyk]

Oehh gek!

Zie de code die ik bijzonder genoeg wel zie staan.

Dim wsArtikelen As Worksheet
Dim wsdebiteuren As Worksheet


Sub prijsafspraak()

rowNum = 2
zoekRow = 2

'Set wsZoekSheet = Sheets("zoeksheet")
Set wsArtikelen = Sheets("artikelen")
Set wsdebiteuren = Sheets("Debiteuren")

lastRow = wsArtikelen.ListObjects("tblArtikelen").Range.Rows.Count
lastColumn = wsArtikelen.ListObjects("tblArtikelen").Range.Columns.Count

If wsArtikelen.Range("C1").Value <> "" Then
    Set rng1 = wsArtikelen.Range("C1", Cells(lastRow, lastColumn))
    rng1.Delete
End If

Do Until wsdebiteuren.Cells(rowNum, 1).Value = ""
    If wsdebiteuren.Cells(rowNum, 3).Value = "Ja" Then
        wsArtikelen.Range("A1").End(xlToRight).Offset(0, 1).Value = wsdebiteuren.Cells(rowNum, 1).Value
        wsArtikelen.Range("A2").End(xlToRight).Offset(0, 1).Formula = "=IFERROR(INDEX(Prijsafspraken!C3,MATCH(1,(R1C=Prijsafspraken!C1)*(RC1=Prijsafspraken!C2),0)),"""")"
        
        wsArtikelen.Range("A1").End(xlToRight).EntireColumn.Replace What:="@", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        zoekRow = zoekRow + 1
    End If
    rowNum = rowNum + 1
Loop

       lastColumn = wsArtikelen.ListObjects("tblArtikelen").Range.Columns.Count
       Set rng1 = wsArtikelen.Range(wsArtikelen.Range("C2"), Cells(lastRow, lastColumn))
       rng1.Value = rng1.Value
End Sub

 

[edmoor]

Waar in je document heb je die geplaatst?
En hoe wordt deze geactiveerd?

 

[Wezenspyk]

In het originele bestand maak ik gebruik van userforms om data toe te voegen, te wijzigen en in te zien.
De code is gekoppeld aan een knop op de userform om de prijsafspraken informatie te wijzigen.

In dit voorbeeld heb ik de formule in een module gezet.

 

[xps351]

Je kan je ook afvragen of dit überhaupt een handige aanpak is. Zoals ik het begrijp komt het er per saldo op neer dat je dezelfde informatie twee keer vast wil leggen.
Ik zou voor dit soort behoeftes sowieso niet voor Excel kiezen, maar voor Access. Dat is er helemaal op ingericht om gegevens eenmalig vast te leggen. De gegevens kan je dan altijd op verschillende manieren presenteren.

 

[Wezenspyk]

Absoluut een goed punt! Echter, het is een onderdeel van een veel groter programma wat ik heb geschreven (dit is de laatste breinbreker). Plus, ik heb dit programma op korte termijn echt nodig. Acces vind ik nog te lastig om mee te werken. Ik zie dit meer als een volgende stap binnen mijn leercurve.

Ik ben er heilig van overtuigd dat Acces mij hierin verder kan brengen, maar ik snap de codering en implementatie nog niet zo goed. Voor ik me hier aan ga wagen wil ik dit wel gereed hebben. Vandaar mijn vraag hier.

Dat terzijde, ik heb zelf deze route binnen de code bewandeld, maar denk dat er best wel wat stappen overgeslagen kan worden binnen mijn VBA-code. Ik hoop ook dat er een VBA-guru is die mij verder kan helpen hierbij!

 

[snb]

Ik begrijp niet waarom je hiervoor VBA zou gebruiken als het met 2 kleine Excelformules kan.

En laat je niets wijsmaken over Access, dat is meestal gebaseerd op onvoldoende kennis van Excel.

 

[Wezenspyk]

Hi allen,
Oplossing is niet wat ik zocht, maar jullie hebben me aan het denken gezet!
Ik heb een veeeeel simpelere oplossing gevonden die perfect voor me werkt.
Dank!

 

[Haije]

En wil je die simpele oplossing ook met ons delen?

 

[Wezenspyk]

En wil je die simpele oplossing ook met ons delen?

Jaa wil ik wel!
Bij het registreren van een verkoop, heb ik inn de VBA ingebouwd dat ik eerst in het tabblad met prijsafspraken zoek. Als hier een fout in zit (Als.Fout), oftewel, de combi tussen afnemer en product niet gevonden wordt in dat tabblad, dan gaat hij zoeken naar de standaard prijs die geldt.
Scheelt een behoorlijk lastige stap (voor mij).
Zoals gezegd, is het een beetje een combi van beide opmerkingen!
DAnk!

 

[snb]

Ik zie helemaal geen VBA.