VBA code rijen invoegen door elkaar

[boomen]

Hallo beste mensen,

Ik heb een model dat door middel van 7 stappen tot een bepaalde kostprijs komt.
Hierin moeten keuzes gemaakt worden door middel van het invoegen van producten die gebruikt zijn.
Voor het invoegen gebruik ik 2x het dubbel klikken.
Deze 2 VBA's staan 1 cel onder elkaar en het probleem dat ik tegenkom is dat als ik bij de bovenste Meer dan 2 rijen invoeg. Als ik na deze handeling het invoegen 1 regel eronder doe komen de 2 verschillende VBA uitkomsten door elkaar te staan.

Dus na het invoegen dus dit: edit:
VBA 1 (formules)
VBA 1 (formules)
VBA 2 (formules1)
VBA 2 (formules1)
VBA 1 (formules)

Terwijl het dit moet zijn:
VBA 1 (formules)
VBA 1 (formules)
VBA 1 (formules)
VBA 2 (formules1)
VBA 2 (formules1)

Dit is de code die ik gebruik:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
End Sub

In kolom A staan dus de waardes 2 tm 7 en 2b tm 7b. Waarde 2 en 2b schakelen dus de verschillende formules in en staan slechts 1cel van elkaar verwijdert.

Ik hoop dat de info die ik gegevens heb duidelijk maakt wat mijn vraag is. Zo niet graag een vermelding.

Grtz

 

[Niels28]

Plaats even je bestand.

Niels

 

[boomen]

Bekijk bijlage Test dubbele VBA.xlsm

Jij moet hem nog wel kennen Niels
Het 1e deel van de code komt van jou, ik heb hem slechts aangepast met hulp van het Forum.

grtz

 

[Niels28]

Ik ken hem ook nog wel maar weet niet wat je in tussen tijd hebt aangepast

Niels

 

[boomen]

Ik heb de targets in het 2e deel dus aangepast. En een andere formulerij toegevoegd voor de bemesting.
De persoon van de bemesting zal op de nummer+b moeten drukken en de bestrijdingsmiddelenman druk op de normale nummers.
In het echte model kloppen de formules wel helemaal met opmaak en dergelijke, Maar het gaat dus om het invoegen.

Als de man van bestrijdignsmiddelen 2 regels plaatst zal de bemesting ertussen komen ipv eronder.

grtz

 

[Niels28]

Zo komt de bemesting altijd onder aan.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.", Target) > 0 And Target <> "" Then
         r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp).Offset(1).Row - Target.Row
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
               
                Target.Offset(r).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(r, 1)
            Next n
        End If
    End If
    Cancel = True
End Sub

Sorry gaat alleen nog goed als je eerst de bestrijding hebt gedaan, nog even puzzelen.

Niels

 

[boomen]

Wederom bedankt Niels, even voor de uitleg.

Je hebt de r toegevoegd als variabele waarin r is 1e deel van de formule.
De waarde van r bepaald dan de plaats waarop deel 2 begint.(hetzelfde als net Maar dan +r naar beneden)

Klopt dit een beetje?

Grtz

 

[Niels28]

Zo werkt ie beter.
zie ook de PS in mijn vorige bericht

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.", Target) > 0 And Target <> "" Then
         r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp).Offset(1).Row - Target.Row
         If r <= 3 Then r = 3
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
               
                Target.Offset(r).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(r, 1)
            Next n
        End If
    End If
    Cancel = True
End Sub

Niels

 

[Niels28]

Ik ga met de xldown naar de eerstvolgende ingevulde cel in kolom A, dan 1 cel naar rechts
met xlup (2x) naar de 2de ingevulde cel van onderaf (hier staat je laatst ingevulde regel) , het rijnummer van de target eraf en je hebt het offset getal (r)

Niels

 

[boomen]

Oke hiermee ga ik het wel redden, wederom bedankt.
Je zult me vast weer een keer voorbij zien komen hier.
En misschien leuk om te weten, tussentijdse beoordeling van mijn stage (dus model) was een 9!
Hier heb je zeker aan bijgedragen, aangezien gebruiksvriendelijkheid ook belangrijk is

Grtz

 

[boomen]

Ik ben met de code tegen een probleem aangelopen.
Op blad 3 heb ik de formules staan die ik door middel van deze code invoer:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.8.9.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.8b.9b.", Target) > 0 And Target <> "" Then
         r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp).Offset(1).Row - Target.Row
         If r <= 3 Then r = 3
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
               
                Target.Offset(r).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(r, 1)
            Next n
        End If
    End If
    Cancel = True
End Sub

Nu kan ik dus bestrijdingsmiddelen invoeren door op de 2. 3. 4. 5. etc.. te klikken in het kostenoverzicht.
Meststoffen doe ik met 2b. 3b. 4b. etc..
Als ik nu de bestrijdingsmiddelen invoer is er niks aan de Hand. Maar de meststoffen zijn afhankelijk van hoeveel bestrijdingsmiddelen invoer. Op blad 3 in E5 zit dus een foutje, of in de VBA. Ik kom er iig niet uit.

Alvast bedankt voor het meedenken.

Grtz

 

[boomen]

Ik heb zelf nog even gekeken, en denk dat de fout zit in het volgende:
Door het gebruiken van de eerst volgende ingevulde cell hiermee

r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp).Offset(1).Row - Target.Row

Gaat de formule op tabblad E5 die ik invoer verkeerd. Iemand een Idee hoe ik dit oplos?

Grtz

 

[Niels28]

Fout zit in E5 want daar staat niks in.
En probeer nou eens duidelijk uit te leggen wat er fout gaat en wat het moet zijn.


Niels

 

[boomen]

Bekijk bijlage Voorbeeldbestand.xlsm
Dit was ik vergeten denk ik xD

 

[boomen]

Is het misschien mogelijk om de mest vanaf dezelfde range als de bestrijdingsmiddelen naar boven in te laten voegen?
Hierdoor blijft het netjes en zitten de macro's elkaar niet in de weg?

grtz

 

[Niels28]

dat kan , dvia de oorspronkelijke macro en staat het weer door elkaar.
Ik heb wel een idee maar daar heb ik pas vanmiddag tijd voor

Niels

 

[boomen]

Dit is de code in E5
=ALS.FOUT($G1*VERT.ZOEKEN(D5;Meststoffen;9;0)/VERT.ZOEKEN(D5;Meststoffen;2;0);"")
De $G1 is wat er fout gaat.
Ik kann die wel veranderen naar $G3 of iets dergelijks Maar hij blijft afhankelijk van het aantal bestrijdingsmiddelen er van te voren zijn ingevoerd.
Ik will dat die zoiezo als ik bij 2b op het 1e blad(Cell A15) iets invul de formule ervoor zorgt dat hij sowieso G16 in blad 1 pakt.

grtz

 

[boomen]

ja dat weet ik haha, klasse.
Maar daarom dacht ik aan dat naar boven invoegen? Of bestaat dat niet?

 

[boomen]

en lopen dan de formules niet nog door elkaar.

 

[snb]

Probeer eens anders te denken:

In plaats van 'rijen invoegen' denk eens aan 'gegevens verplaatsen'.

Voor Excel is een rij (met alle kolommen die daarbij horen) 'invoegen' (wat eigenlijk niet kan om dat het aantal rijen van een werkblad gefixeerd is op 2 ^20) rekentechnisch een veel complexere opgave dan het verplaatsen van een beperkte set aan gegevens.