variabel bereik variabel aantal keren kopieren

[Josbtje]

Hoi,

ik zit met het volgende, ik zou graag een vast bereik I10:M10 en een variabel bereik in de kolommen A t/m U dat begint op A11 t/m de laatste gegevens op rij 'x' te zoeken in kolom O meerdere keren willen kopieren "onder elkaar met 2 rijen afstand" afhankelijk van de productie aantallen opgegeven in cel C4 gedeeld door 5 en afgerond naar boven.

All help is appreciated

 

[MarcelBeug]

Hoi, welkom op het forum.

Het aardige van dit forum is, dat je ook voorbeeldbestandjes kunt plaatsen.
Dat zal je verhaal ongetwijfeld verduidelijken.
Ik snap er in ieder geval nu niet veel van.

Groet,
Marcel

 

[sylvester-ponte]

die handtekening kun je beter verwijderen

 

[Josbtje]

Bekijk bijlage Template.xls

 

[MarcelBeug]

Kun je in het voorbeeld ook aangeven hoe het resultaat er uit moet zien?
Het zal overigens wel een VBA oplossing moeten worden en daar ben ik zelf nog niet zo in thuis.
Met welke versie van Excel werk je? En welke taal: Engels/Nederlands/anders?

 

[Josbtje]

ik heb 2 voorbeeld uitgaven (andere tabbladen) gemaakt wat ik zou willen bereiken eventueel een onderbreking in de tabel zou ook mogen (zonder opmaak)
ik gebruik een Nederlandse editie van office. dat de oplossing in VBA gaat zijn had ik inderdaad wel al gedacht

 

[MarcelBeug]

Nou, ik heb een opzetje gemaakt waar de echte VBA-ers hier naar hartelust op kunnen schieten.
Het variabele deel kopiëren werkt (althans het doet iets); het vaste deel krijg ik niet in orde. En nu heb ik even geen tijd meer.

Sub kopieer()

    Dim AantalKopieen As Integer
    Dim Kopie As Integer
    Dim VastBereik As Range
    Dim VariabelBereik As Range
    Dim AantalRegels As Double
    
    
    Blad1.Activate
    AantalKopieen = Round(0.5 + Int(Blad1.[c4].Value / 5), 0) - 1
    If AantalKopieen = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set VastBereik = Range("I10:M10")
    AantalRegels = Application.WorksheetFunction.CountIf(Range("O:O"), "?")
    Set VariabelBereik = Range("A11", "U" & 10 + 2 * AantalRegels)
    VariabelBereik.Copy
       
    Kopie = 1
    Do While Kopie <= AantalKopieen
        'De volgende 5 regels doen niet wat de bedoeling is
        Range("I10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("I10").Value + 5 * Kopie
        Range("J10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("J10").Value + 5 * Kopie
        Range("K10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("K10").Value + 5 * Kopie
        Range("L10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("L10").Value + 5 * Kopie
        Range("M10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("M10").Value + 5 * Kopie
        
        Range("A12").Offset(2 * (AantalRegels + 3) * Kopie).PasteSpecial
        Kopie = Kopie + 1
    Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 

[Josbtje]

Dank voor het opzetje.

Zou het kunnen dat het kopiëren van de vaste selectie niet goed gaat omdat dat enkele cellen zijn en de doel cellen 'merged' zijn?
Ga ik straks nog testen wat er gebeurt met deze code

 

[MarcelBeug]

Het variabel bereik kun je ook misschien beter wat extra regels geven:
Set VariabelBereik = Range("A11", "U" & 10 + 6 + 2 * AantalRegels)

Het mergen van cellen levert in het algemeen problemen op als je iets wilt doen met die gegevens.
Zo heb ik al een countif gedaan om het aantal regels te bepalen.

Ik zou bijna willen zeggen: "Een echte Excellert merget niet". :d

 

[Josbtje]

Vo heb ik het nu getest
ik heb alleen een [roundup] functie toe gepast ipv [round +0,5] ik kreeg anders met een serie van 15 => 1 extra kopie en bij 14 => 2 kopieën
de extra ruimte heb ik opgevolgd (+6)

hoe die 5 regels werkend te krijgen weet ik ook niet heb wel nog wat geprobeerd maar kreeg alleen maar fout meldingen

Sub kopieer()

    Dim AantalKopieen As Integer
    Dim Kopie As Integer
    Dim VastBereik As Range
    Dim VariabelBereik As Range
    Dim AantalRegels As Double
    
    
    Blad1.Activate
    AantalKopieen = WorksheetFunction.RoundUp(Blad1.[c4].Value / 5, 0) - 1
    If AantalKopieen = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set VastBereik = Range("I10:M10")
    AantalRegels = Application.WorksheetFunction.CountIf(Range("O:O"), "?")
    Set VariabelBereik = Range("A11", "U" & 10 + 6 + 2 * AantalRegels)
    VariabelBereik.Copy
       
    Kopie = 1
    Do While Kopie <= AantalKopieen
        'De volgende 5 regels doen niet wat de bedoeling is
        Range("I10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("I10").Value + 5 * Kopie
        Range("J10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("J10").Value + 5 * Kopie
        Range("K10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("K10").Value + 5 * Kopie
        Range("L10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("L10").Value + 5 * Kopie
        Range("M10").Offset(2 * (AantalRegels + 3) * Kopie).Value = Range("M10").Value + 5 * Kopie
        
        Range("A12").Offset(2 * (AantalRegels + 3) * Kopie).PasteSpecial Paste:=xlPasteAll, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Kopie = Kopie + 1
    Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 

[sylvester-ponte]

wat moet er gebeuren als in kolom "O" een tekentje weg is?

 

[Josbtje]

sylvester-ponte
wat moet er gebeuren als in kolom "O" een tekentje weg is?

wat bedoel je hier precies mee?

Als er in kolom O geen wortel teken staat is het onderdeel fout en dus uitval, die wordt vervolgens gedocumenteerd en verschot
en het kopieeren gebeurt voordat ik de productgegevens moet invoeren.

 

[sylvester-ponte]

in je eerst post staat:

ik zit met het volgende, ik zou graag een vast bereik I10:M10 en een variabel bereik in de kolommen A t/m U dat begint op A11 t/m de laatste gegevens op rij 'x' te zoeken in kolom O....

wat moet er met de gegevens ( de 'x'en )uit kolom O gebeuren?

 

[Josbtje]

sylvester-ponte
in je eerst post staat:

ik zit met het volgende, ik zou graag een vast bereik I10:M10 en een variabel bereik in de kolommen A t/m U dat begint op A11 t/m de laatste gegevens op rij 'x' te zoeken in kolom O....

wat moet er met de gegevens ( de 'x'en )uit kolom O gebeuren?

In kolom O staat altijd de laatste gegevens om te bepalen hoeveel rijen er dienen te worden gekopieerd, het zou ook kolom F, I, J, K, L, of M mogen zijn de rest is is niet altijd ingevuld de x staat voor een variabele rij nr.

 

[Josbtje]

Heb de code samen gevoegd met het definitief bestand

Hoi supporters,

Ik heb de laatste code samengevoegd in het uiteindelijke bestand.

tab 1 (Meetrapport) is het bron,
tab 2 (CTQ Maten) is resultaat nu
tab 3 (CTQ Maten(2)) is gewenste resultaat

iemand nog suggesties??