Formule`s doortrekken en plaatsen via VBA

[HWV]

Beste,

Ik heb van kolom M tm T formules gemaakt die ik met VBA moet verwerken.

Kolom M =ALS(G2="";H2;ALS(F2="DST";D2;ALS(E2="";F2;ALS(D2="PAL";F2;""))))
Kolom N =ALS(M2="";H2;"")
Kolom O =TEKST.SAMENVOEGEN(M2;N2)
Kolom P =ALS(G2="";"";ALS(F2="DST";ALS(E2="";"";E2*1000);ALS(E2="";G2;ALS(D2>0;G2;""))))
Kolom Q =H2
Kolom R =ALS(P2="";S2;T2)
Kolom S =ALS(Q2=O2;Q2;ALS(O2="PAL";Q2;TEKST.SAMENVOEGEN(O2;" ";P2;" ";Q2)))
Kolom T =ALS(Q2=O2;Q2;ALS(O2="PAL";Q2;TEKST.SAMENVOEGEN(O2;" ";"á";" ";P2;" ";Q2)))

Wat ik wil is het volgende :

Een excel bestand wat elke dag geupdate wordt moet ik ook nog bewerken met een aantal formule om een juiste excel sheet te krijgen.
Nu wil ik de bovenstaande formule`s via VBA maken en doortrekken tot 10.000 regels.

- hoe kan ik dit maken via VBA
- dat ik dit door kan trekken tot 10.000 regels en dan absoluut maken

Kolom M tm S zijn hulpkolomen die ik hierna weer ga verwijderen.

Groet HWV

 

[danny147]

Beste HWV

Wat is er mis met de formules, dat je kiest voor VBA ?
Je kan toch gewoon kolom T kopiëren, speciaal plakken en op waarden en OK klikken.
Dit enkel zou je een macrotje kunnen van maken.
Daarna kan je kolommen M:S verwijderen

Groetjes Danny. :thumb:

 

[HWV]

Beste Danny,

Ik krijg het bestand elke dag binnen zonder de formule`s dus enkel alleen de afkortingen.
Om het bestand te kunnen bewerken moet ik het wel met VBA doen, want anders moet ik elke dag zelf de formule`s er aan gaan hangen.

Mijn opzet is nu om het met VBA te doen:

- Bestand ophalen
- Bewerken
- Opslaan

Deze formule hang ik aan bv bestellijsten zodat ze elke dag met de gegevens van de vorige dag werken.

Dit ivm dat dan ander collega`s het bestand kunnen gebruiken voor offerte`s, bestellijsten, orderbonnen enz.

Waar ik zelf ook nog over nadenk is hoe kan ik er voor zorgen dag hij nu automatisch deze actie gaat uitvoeren.
bv
Om 18:30 worden de gegevens geplaats door ons systeem in een map.
Daar zou het dan moeten worden opgehaald, en dan bewerkt moeten worden en weer worden opgeslagen.
Maar op deze manier weet ik niet of dat mogelijk is vandaar mijn vorige optie

Groet HWV

 

[danny147]

Beste HWV

Zie bestandje met code voor 10000 regels.

Had het liever anders gezien met in cel AA1 het aantal regels in te voegen.
Dan in de code [M2:M & AA1.Value], maar dit lukte mij niet.

Ik zal zien of ik het kan vinden, ander moet iemand deze proberen aan te passen.

Nu ga je verveelt zitten met al die nullen.

Groetjes Danny. :thumb:

 

[HWV]

    Range("M2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-6]="""",RC[-5],IF(RC[-7]=""DST"",RC[-9],IF(RC[-8]="""",RC[-7],IF(RC[-9]=""PAL"",RC[-7],""""))))"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-6],"""")"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-9]="""","""",IF(RC[-10]=""DST"",IF(RC[-11]="""","""",RC[-11]*1000),IF(RC[-11]="""",RC[-9],IF(RC[-12]>0,RC[-9],""""))))"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-9]"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",RC[1],RC[2])"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]=RC[-4],RC[-2],IF(RC[-4]=""PAL"",RC[-2],CONCATENATE(RC[-4],"" "",RC[-3],"" "",RC[-2])))"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]=RC[-5],RC[-3],IF(RC[-5]=""PAL"",RC[-3],CONCATENATE(RC[-5],"" "",""á"","" "",RC[-4],"" "",RC[-3])))"
    Range("M2:T2").Select
    Selection.Copy
    Range("M3:T10000").Select
    ActiveSheet.Paste
    Range("M2").Select
    Application.CutCopyMode = False

Danny,

Ik ben tot het volgende gekomen, helaas wel even de macro opname gebruikt.
Werkt wel.
nu nog de vraag hoe kan ik dit elk dag automatisch laten draaien, en of er een mooier code bestaat voorbovenstaande

groet HWV

 

[danny147]

Beste HWV

Mijn code deed het toch goed tot aan 10000 rijen, waarom deze macro dan ?
Deze macro is maar voor 1 regel

Stop de code in je persoonlijke Macromap en je kan ze dan in alle mappen de code opvragen.

Sub formules()

    [M2:M10000] = _
        "=IF(RC[-6]="""",RC[-5],IF(RC[-7]=""DST"",RC[-9],IF(RC[-8]="""",RC[-7],IF(RC[-9]=""PAL"",RC[-7],""""))))"
    [N2:N10000] = _
        "=IF(RC[-1]="""",RC[-6],"""")"
    [O2:O10000] = _
        "=CONCATENATE(RC[-2],RC[-1])"
    [P2:P10000] = _
        "=IF(RC[-9]="""","""",IF(RC[-10]=""DST"",IF(RC[-11]="""","""",RC[-11]*1000),IF(RC[-11]="""",RC[-9],IF(RC[-12]>0,RC[-9],""""))))"
    [Q2:Q10000] = _
        "=RC[-9]"
    [R2:R10000] = _
        "=IF(RC[-2]="""",RC[1],RC[2])"
    [S2:S10000] = _
        "=IF(RC[-2]=RC[-4],RC[-2],IF(RC[-4]=""PAL"",RC[-2],CONCATENATE(RC[-4],"" "",RC[-3],"" "",RC[-2])))"
    [T2:T10000] = _
        "=IF(RC[-3]=RC[-5],RC[-3],IF(RC[-5]=""PAL"",RC[-3],CONCATENATE(RC[-5],"" "",""à"","" "",RC[-4],"" "",RC[-3])))"

End Sub

Groetjes Danny. :thumb:

 

[HWV]

geen nullen in de sheet

Beste Danny,

Op deze manier heb ik niet de nullen in de sheet.
Ik plaats de formule`s in rij 2 en dan kopieer ik deze tot regel 10000 en werkt zo wel.
Maar zoals gezegd niet de mooiste code

groet HWV

 

[danny147]

Beste HWV

Of je moet telkens het bereik in de code aanpassen, dan lukt het ook.

Ik zou nog wat afwachten of iemand mijn code kan aanpassen en verwijzen naar variabele celverwijzing via gegevens uit de cel AA1

Bereik moet dan worden [M2:M&"(range("AA1").Value)], maar deze lukt niet.
Met in AA1 de laatste rij waar gegevens in staan.

Groetjes Danny. :thumb:

 

[Warme bakkertje]

Sub formules()
    Range("M2:M" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-6]="""",RC[-5],IF(RC[-7]=""DST"",RC[-9],IF(RC[-8]="""",RC[-7],IF(RC[-9]=""PAL"",RC[-7],""""))))"
    Range("N2:N" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-1]="""",RC[-6],"""")"
    Range("O2:O" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=CONCATENATE(RC[-2],RC[-1])"
    Range("P2:P" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-9]="""","""",IF(RC[-10]=""DST"",IF(RC[-11]="""","""",RC[-11]*1000),IF(RC[-11]="""",RC[-9],IF(RC[-12]>0,RC[-9],""""))))"
    Range("Q2:Q" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=RC[-9]"
    Range("R2:R" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-2]="""",RC[1],RC[2])"
    Range("S2:S" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-2]=RC[-4],RC[-2],IF(RC[-4]=""PAL"",RC[-2],CONCATENATE(RC[-4],"" "",RC[-3],"" "",RC[-2])))"
    Range("T2:T" & Cells(Rows.Count, 1).End(xlUp).Row) = _
        "=IF(RC[-3]=RC[-5],RC[-3],IF(RC[-5]=""PAL"",RC[-3],CONCATENATE(RC[-5],"" "",""à"","" "",RC[-4],"" "",RC[-3])))"
End Sub

 

[danny147]

Beste Warme bakkertje

Deze is natuurlijk beter, zoekt direct de laatste rij waar gegevens staan. :thumb:

Deze moet ik onthouden

Groetjes Danny. :thumb:

 

[HWV]

Beste Rudi,

Bedankt weer voor jou oplossing van mijn uitdaging (probleem)
Ben weer een stap verder hiermee gekomen.

Nu nog even kijken of ik deze automatisch kan laten lopen elek dag :-(

Groet HWV

 

[Ginger]

Zonder nou heel vervelend te willen zijn... Waarom moet die hele sheet worden volgepropt met formules terwijl je met VBA in de weer bent? Dit lijkt me persoonlijk nogal dubbelop want zoals ik het nu zie ben je in de cellen met formules alleen maar opzoek naar een vaste waarde (dus de formules worden slechts 1x 'ingezet'). Als mijn stelling klopt kan je dus beter en sneller het 'vullen van die cellen' volledig binnen VBA afhandelen en daarna de data in 1 klap naar de sheet wegschrijven.

Klopt mijn stelling?

Groet, Leo

 

[HWV]

In de bijlage, een voorbeeld van het bestand

Beste Ginger,

Bedankt voor jou reactie.

In het kort:

In mijn bestand daar staan de eenheden van het artikel
.
In kolom B t/m G kan de dooseenheid staan die ik moet gebruiken.
ik wil altijd de laagste verpakking hebben.
Omdat ik wel eens voor 1 artikel meerder (bv Ds =Doos en PAL=Pallet)verpakkingseenheden heb staan heb, ik de als formule`s gebruikt.
Omdat ook in dezelfde regel er een prijseenheid kan staan DST (1000) moet ik die er ook uithalen.nu op mijn manier heb ik dit kunnen filteren.
Nu ik de code heb laten draaien inlc. het ophalen vanaf een andere server en de kolom A omzetten van tekst naar getallen doet hij er ruim 4 minuten over. Inderdaad wel erg lang.
ik sta zeker open voor verbetering of andere oplossingen.

Groet HWV

Ps bedankt voor het meedenken

 

[Ginger]

HWV, voordat ik me nu volledig op een VBA-uitwerking stort, zet eerst deze formule 'ns in cel U2 van je voorbeeldsheet...

NL     =ALS(F2="DST";"DS";F2) & " á " & ALS(F2="DST";E2*G2;G2) & " " & H2

ENG    =IF(F2="DST";"DS";F2) & " á " & IF(F2="DST";E2*G2;G2) & " " & H2

Ik heb namelijk het idee dat deze formule hetzelfde doet als al je hulpkolommen bij elkaar... (Het artikel in regel 6 snap ik niet helemaal, dus kijk daar even goed naar de uitkomst!)

Groet, Leo

 

[HWV]

=ALS(F2="DST";"DS";F2) & " á " & ALS(F2="DST";E2;1*G2;[COLOR="Red"]G2[/COLOR]) & " " & H2

Beste,

Ik krijg een foutmelding op het rode gedeelte.

PS kan jij misschien kijken naar mijn laatste bijlage.
Dit is de bijlage incl mijn totale code, en is iets anders als mijn eerdere bijlage vandaar.

groet HWV

 

[Ginger]

Ik krijg een foutmelding op het rode gedeelte.

Klopt! Ik had die aanpassing al gemaakt, maar toen had jij de formule al overgenomen. Pak 'm even opnieuw van het forum en test nogmaals....

Dan zal ik na je reactie nog je nieuwe workbook bekijken.

Groet, Leo

 

[HWV]

Beste,


In de bijlage heb ik wat opmerkingen gezet bij de artikelen waar hij het niet goed weer geef.
Deze eenheden komen uit mijn orginele bestand

Groet HWV

 

[Ginger]

Eenheden die voor kunnen komen in kolom B t/m G
ROL
DS
STK
PAL
SET
KG
BL
BLI
DIS
BUN
MAP
MTR
PAK
PR
VEL
ZAK
PAK
OMD
BOL

Nou vrees ik dat je me zometeen gaat vertellen dat elke code een eigen zéér uitgebreide set van mogelijkheden heeft... Kan je bij elke code een unieke set van regels geven? Zo nee? Dan houdt de hulp hier voor wat mij betreft op. Programmeren op iets 'niet eenduidigs' loopt vaak uit op een drama!

Groet, Leo

P.s. Ben nu ff een paar uur offline...

 

[HWV]

Leo,

Bedankt voor je inzet.

Met de code in topic 13 dekt de lading. Is niet de mooiste code maar werkt wel en vangt alles uit het rijtje op.

Groet HWV

 

[HWV]

Probleem opgelost

Beste,

Met behulp van Leo (Ginger) gekomen tot een oplossing van een probleem wat ik dacht dat onmogelijk zou zijn
Hij heeft twee optie`s aangedragen om te kijken wat voor mij het beste zal werken.
Zo heeft hij een formule gemaakt en een UDF

De formule:

=ALS(OF(EN(D2="PAL";F2<>"DST");EN(D2="";F2="");EN(D2="";F2="DST"));H2;ALS(F2="DST";D2;F2) & " á " & ALS(F2="DST";E2*G2;G2) & " " & H2)

en de UDF:

Function Omschrijving(VE2 As String, CO2 As Double, VE1 As String, _
                CBV1 As Double, BV1 As String) As String
'Code van Leo Meijer (Ginger) voor Helpmij.NL; 20/03/2010
'VE2 = VerpakkingsEenheid2 = D2
'CO2 = Coefficient Omverpakking = E2
'VE1 = VerpakkingsEenheid1 = F2
'CBV1 = Coefficient Binnen Verpakking = G2
'BV1 = Basis Verpakking = H2
'=IF(OR(AND(D2="PAL";F2<>"DST");AND(D2="";F2="");AND(D2="";F2="DST"));H2;IF(F2="DST";D2;F2) & " á " & IF(F2="DST";E2*G2;G2) & " " & H2)
    
    Application.Volatile
    
    If (VE2 = "PAL" And VE1 <> "DST") Or (VE2 = "" And VE1 = "") Or (VE2 = "" And VE1 = "DST") Then
        Omschrijving = BV1
    Else
        'IF(F2="DST";D2;F2) & " á " & IF(F2="DST";E2*G2;G2) & " " & H2)
        Omschrijving = IIf(VE1 = "DST", VE2, VE1) & " á " & IIf(VE1 = "DST", CO2 * CBV1, CBV1) & " " & BV1
    End If

End Function

Sub MaakOmschrijving()
'Code van Leo Meijer (Ginger) voor Helpmij.NL; 20/03/2010

    On Error GoTo Einde
    
    c1 = Selection
    ReDim c2(1 To UBound(c1), 1 To 1)
    For i = 1 To UBound(c1, 1)
        c2(i, 1) = Omschrijving(CStr(c1(i, 4)), CStr(c1(i, 5)), CStr(c1(i, 6)), CStr(c1(i, 7)), CStr(c1(i, 8)))
    Next i

    [M2].Resize(UBound(c1), 1).Value = c2

    Exit Sub

Einde:
    MsgBox "Je hebt iets fout gedaan! (misschien niet de juiste selectie - range(A2:L???) - ?", vbOKOnly, "Fout"
End Sub

met de functie:

=omschrijving(D2;E2;F2;G2;H2)

Ik heb ze allebei geprobeerd maar ga voor de eerste optie van Ginger zoals hij zelf ook heb aangegeven dat dit de beste formule zal zijn.

Hierbij je bestandje retour met daarin:
• de door mij aangereikte formule (vind ik trouwens dé aanbevolen optie!)
• een UDF die je in de sheet kan gebruiken (gebruikt daarmee onnodig veel resources omdat een UDF minder slim met het geheugen omgaat dan de ingebouwde functies van Excel zelf)
• een knop die een code aanstuurt om kolom M te vullen (selecteer hiervoor het bereik A2 tot en met de laatste cel van kolom L en druk op de knop. Deze code zet de tabel in het geheugen van je computer en handelt daar alles af om tot slot de data weg te schrijven naar je sheet)

Ik meen de opmerking bij mijn 1e optie serieus! Als je niet echt perse met VBA aan de slag hoeft omdat je het nog kan oplossen met de standaard functies en functionaliteiten van Excel, moet je altijd kiezen voor de standaard formules. En zoveel moeite is het toch niet om de formule in cel M2 te kopiëren en met de vulgreep tot onder aan toe te plakken?
Onderzoek het verschil maar eens. Maak het bereik O3-P7927 maar eens leeg en vul dan eerst de cellen met de vulgreep vanaf cel O2 (= direct klaar!) en dan hetzelfde maar met cel P2 (je ziet je pc rekenen).

In de bijlage een voorbeeld van het bestand met een schat aan mogelijkheden, maar Ginger heeft de juiste formule hier voor gevonden

Iedereen bedankt

Groet HWV