Bestaand stukje code - aanpassen

[pietjedekikker]

Destijds heeft SuperZeeuw op dit forum voor mij een stukje code geschreven. De werking van de code is alsvolgt:

Er is een tabblad met Kleurentabel, in de eerste kolom staat de naam van het product (bv Fleurielle) de cellen achter dit product zijn de kleuren met de daarbij behorende percentage (meerprijs).
Het stukje code leest de merknaam uit tabblad Prijslijst, zoekt deze op in tabblad Kleurentabel en zet deze in tabblad Prijslijst kolom Q achter elkaar neer. In de kolom S komen deze ook achter elkaar maar dan is de percentage omgerekend naar een bedrag (aan de hand van Consumententotaal excl. btw).

Tot zover is het stukje code werkend. Bij deze zoek ik een uitbreiding op deze code. De vraag is alsvolgt: In de kleurentabel komen nu ipv percentages ook bedragen voor. Dus als er geen % teken bij staat, mag het gehele getal worden overgenomen.

Zie ook: http://www.helpmij.nl/forum/showthread.php/517672-waarden-uitlezen-en-percentage-omrekenen

Voorbeeldbestand toegevoegd.

Stukje code is alsvolgt:

Columns(17).ClearContents
    Columns(19).ClearContents
    For x = 7 To Range("F65536").End(xlUp).Row
        With Sheets("Kleurentabel").Range("a1:a500")
            Set c = .Find(Cells(x, 10).Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                t = 3
                Do
                    Waarde1 = Waarde1 & Sheets("Kleurentabel").Cells(c.Row, t).Value
                    First = InStr(1, Sheets("Kleurentabel").Cells(c.Row, t).Value, "[", vbTextCompare)
                    Last = InStr(1, Sheets("Kleurentabel").Cells(c.Row, t).Value, "%", vbTextCompare)
                    NextCell = Left(Sheets("Kleurentabel").Cells(c.Row, t).Value, First) _
                        & Int(Cells(x, "U").Value * Val(Mid(Sheets("Kleurentabel").Cells(c.Row, t).Value, First + 1, Last - First))) / 100 _
                        & Mid(Sheets("Kleurentabel").Cells(c.Row, t).Value, Last + 1, 10)
                    Waarde2 = Waarde2 & NextCell
                    t = t + 1
                Loop While Sheets("Kleurentabel").Cells(c.Row, t).Value <> ""
                Cells(x, 17).Value = Waarde1
                Cells(x, 19).Value = Waarde2
                Waarde1 = ""
                Waarde2 = ""
            Else
                Cells(x, 17).Value = "Type niet gevonden in de lijst"
            End If
        End With
    Next x
    Application.ScreenUpdating = True
      Columns("S:S").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="].", Replacement:="],", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
     Selection.Replace What:="[", Replacement:="[+", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Hopelijk kan iemand me hierbij helpen.Bekijk bijlage Prijslijst_V10_small.rar

 

[Superzeeuw]

Piet,

Leuk om te horen dat mijn code goed werkt en jij het met plezier gebruikt.
Het was geen moeilijke vraag dus heb ik de code aangepast naar wens.

Test hem eens uit en laat even weten of dit is wat je wilt.

 

[pietjedekikker]

Aanpassing stukje code

Bovengenoemde code van Superzeeuw gebruik ik al enkele jaren naar volle tevredenheid!
Echter is de importmodule aangepast en moet de lijst in een andere vorm worden ingelezen.

Kan iemand mij helpen met het aanpassen van bijgaand stukje code?
In de excelsheet heb ik een voorbeeld en wat opmerkingen gezet.

Heel hartelijk dank alvast!Bekijk bijlage Aangepaste Prijslijst_V10.1_small.xlsm

 

[Superzeeuw]

Piet,

Heel leuk te horen dat de code meer dan 2 jaar succesvol is geweest.
Ik wil je best helpen maar dan heb ik wel meer info nodig.
De info op de sheet zegt mij niet genoeg.
Ik moet even afhaken met de uitleg voor kolom Q en S.

P.S.: Ik mag helaas geen privé berichten versturen.

 

[pietjedekikker]

Algemeen
Het is een prijzenlijst voor een webshop. Het is de bedoeling dat men een product kiest en bij dat product kunnen ze een kleur kiezen. In sommige gevallen is kost dit niets (0 euro) en andere gevallen een percentage van het product of een vaste waarde.

Kolom Q en S
Voor elke kleur die gekozen kan worden moet er een titel aanwezig zijn. Deze wordt in Kolom Q gezet. Als de naamgeving van de titel hetzelfde is dan ziet we webshop dat als een keuzelijst.
Je kunt dus zeggen dat voor elke kleurkeuze er in kolom S het woord "Kleur keuze" moet staan.

Kolom S is het bedrag wat de keuze kost. Of het is een vaste waarde of het is een percentage van het product.

Voorbeeld
Onderstaand een voorbeeld zoals het eruit komt te zien in de webshop.
Let even niet op het bedrag dat is anders.





Is het duidelijker zo?

 

[Superzeeuw]

Piet,

Deze opfrisser helpt mij zeker verder op weg.
Maar wat is er anders dan de vorige keer dat het wel werkte, wat is er verandert?

 

[pietjedekikker]

Hoi Superzeeuw,

Ik moest overstappen van de webshop van Virtuemart 1 naar versie 2. Deze laatste gaat anders om met deze velden.
Bijgaand een bestand hoe ik de oude situatie inlees en het bestand hoe versie 2 ingelezen wil worden. Hij haalt dus de waarden uit elkaar.

Bekijk bijlage Inlezen_kleur_nieuw.txtBekijk bijlage Inlezen_kleur_oud.txt

 

[Superzeeuw]

Piet,

Wat is nu de bedoeling precies?

De code ontrafelt enkel de gegevens welke geïmporteerd zijn op tabblad "Kleurentabel".
Wil je dat ik die code aanpas of bedoel je iets anders?

 

[pietjedekikker]

Het mooiste zou zijn dat de code wordt aangepast met de volgende uitkomst:
- kolom Q: als de productnaam uit kolom G van tabblad Prijzenlijst overeenkomt met de kolom A van het tabblad kleurentabel dan in kolom Q het woord "Kleur keuze" gescheiden met een komma vermelden. Het aantal keer het word "Kleur keuze" is afhankelijk van het aantal kleuren in het tabblad Kleurentabel van dat product.
- kolom R: als de productnaam uit kolom G van tabblad Prijzenlijst overeenkomt met de kolom A van het tabblad Kleurentabel dan in kolom R de Kleuren achtereenvolgens vermelden gescheiden door een komma.
- kolom S: als de productnaam uit kolom G van tabblad Prijzenlijst overeenkomt met de kolom A van het tabblad Kleurentabel dan in kolom S het bedrag bepalen voor die kleur. In geval van % dan het percentage van dat Consumentotaalprijs van het betreffende product. Als er geen percentage bij staat dan is het een vast bedrag en mag dat worden overgenomen.

 

[Superzeeuw]

Piet,

Het bestand 'Aangepaste Prijslijst_V10.1_small.xlsm' heeft de juiste info op tabblad 'Kleurentabel'?

Die vraag stel ik want de beide tekst bestanden wijken enorm af van elkaar.
Oftewel heb je de nieuwe tekst file ingelezen op tabblad 'Kleurentabel'

 

[pietjedekikker]

Ik heb wat voorbeelden ingevuld, de inhoud van de tekstbestanden komen niet overeen met de kleurentabel. Ik heb deze met de hand gevuld om je een indruk te geven hoe het eruit zit (qua format)

De kleurentabel kan worden aangevuld, zowel met productnamen, kleuren als bedragen.

 

[Superzeeuw]

Piet,

Om de code aan te kunnen passen moet ik een bestand hebben met de juiste informatie op het tabblad Kleurentabel, heb ik die nu?

 

[pietjedekikker]

Bijgaand de laatste versie.Bekijk bijlage Kleurentabel.xlsx

 

[Superzeeuw]

Piet,

Bijgevoegd bestand doet volgens mij wat jij verwacht.

Graag goed controleren met verschillende Productnamen.

LET OP!!
Minimaal 1 Productnaam komt 2x voor in de lijst op tabblad Kleurentabel. dat is Bohemia. Mijn code zoekt naar het product en de eerste die wordt gevonden wordt gehanteerd, de tweede ziet de code nooit.

Nieuwe File: Bekijk bijlage Aangepaste Prijslijst_V10.2_small.xlsm

 

[pietjedekikker]

Super, het werkt! Ontzettend bedankt!

 

[Superzeeuw]

Graag gedaan en veel plezier ermee.