Actie na voldoen aan waarde

Status
Niet open voor verdere reacties.
H

Halbertsma

Gebruiker
Lid geworden
25 jun 2009
Berichten
34
Hallo,.

Ik heb deze vraag ook al elders op het forum gepost, maar dat blijkt de verkeerde plek te zijn geweest.

Ik ben niet erg bekend met programmeren/VBA, maar ik zou graag het volgende willen doen:


Ik heb een aantal kolommen met getallen. in kolom E wordt een waarde cumulatief opgeteld.
Zodra getal in kolom E tussen de 990 en 1100 (1000 +/- 10%) zit moeten de kolommen ervoor (B,C, D en E) geselecteerd worden

In het geval van het voorbeeld bereikt kolom E de vereiste waare bij rij 19.
Het document moet nu automatisch rij 4 t/m 19, lokom B,C, D en E selecteren. (in het voorbeeld geel gemarkeerd)
Vervolgens moeten deze waarden verplaatst worden naar een nieuwe sheet

De cumulatieve telling begint nu weer bij 0
Het mooiste zou zijn als het zelfde nu herhaald wordt:
Zodra de cumulatieve telling de 1000 bereikt wordt er een nieuwe sheet aangemaakt
waarin de (in het geval van het voorbeeld -groen gemarkeerd-) rijen 20 t/m 36 (kolommen B,C,D en E) verplaatst worden naar de nieuwe sheet


Ik hoop dat iemand me hier mee kan helpen, het bijgevoegde bestand maakt het een en ander hopelijk duidelijker
 

Bijlagen

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Columns(5), Target) Is Nothing Then
    If WorksheetFunction.Sum(Columns(5)) > 990 Then
      sq = UsedRange.Columns("B:E")
      Sheets.Add
      Sheets(1).Cells(1, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
    End If
  End If
End Sub
 
Bedankt voor het posten van een mogelijke oplossing.
Ik probeer dit scritp nu in te vullen in macro's, maar dan geeft ie aan dat hij een End sub verwacht.
Er gaat dus iets niet helemaal goed.

Het toevoegen van een "End sub" line onderaan de code werkt niet. mogelijk moet ie ergens anders staan?

edit: Ik moest natuurlijk de "Sub ()"aan het begin van de code verwijderen.
Dat heb ik nu gedaan dus de foutmelding is weg, maar nu zie ik de code nietschijnen in het lijstje met macro's in excel, terwijl hij wel in VB module 1 staat.

Een idee? (zoals waarschijnlijk duidelijk is, ben ik een flinke newbie)
 
Laatst bewerkt:
deze code loopt automatisch als je iets in een cel van kolom E wijzigt en daarna op tab of enter slaat.
 
snb zei:
deze code loopt automatisch als je iets in een cel van kolom E wijzigt en daarna op tab of enter slaat.
Klik om te vergroten...

Dat is niet helemaal wat ik zoek.
Ik heb dit namelijk nodig voor het maken van een productielijst. Ik download om de zoveel tijd een excelfile uit een orderprogramma. Ik verander dus zelf niks. DE opdracht zou uitgevoerd moeten worden zodra ik daar opdracht toe geef (in de zin van op macro's klik en de handeling uit laat voeren)

Het gaat er mij om dat ik, wanneer ik de geexporteerde file open in excel, deze in eerste instantie sorteer op datum (dat is me al gelukt) en vervolgens kijk naar het aantal punten (cumulatief).
Zodra deze boven de 1000 komt (plusminus 10%) moeten rijen (die samen dus 1000 punten waard zijn) verplaatst worden naar een nieuwe sheet. Dit is dan dag 1 van de productie. De volgende rijen (die samen 1000 punten zijn) moeten verplaatst worden naar weer een nieuwe sheet. enzovoorts totdat de rijen op zijn.

Ik hoop van ganse harte dat u mijn verder kunt helpen!!
 
Dat is een heel andere vraag.
Code: 
Sub dagsplitsing()
  jj=1
[COLOR="Red"]  With Sheets("xxx")[/COLOR]
    for j= 1 to [COLOR="red"].[/COLOR]usedrange.columns(5).specialcells([COLOR="Red"]2[/COLOR]).count
      If WorksheetFunction.Sum([COLOR="red"].[/COLOR]cells(jj,5).resize(j-jj)) > 990 Then
        sq = [COLOR="red"].[/COLOR]cells(jj,5).offset(,-3)[COLOR="red"].[/COLOR]resize(j-jj,4)
        Sheets.Add
        Sheets(1).Cells(1, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
        jj=j
      End If
    next
  [COLOR="Red"]end with[/COLOR]
End Sub
 
Laatst bewerkt:
snb zei:
Dat is een heel andere vraag.
Code: 
Sub dagsplitsing()
' Zet variabele jj als 1
  jj=1
'  ??
  for j= 1 to usedrange.columns(5).specialcells(1).count
'  Als de betreffende cell >990 is dan
    If WorksheetFunction.Sum(cells(jj,5).resize(j-jj)) > 990 Then
'  ??
      sq = cells(jj,5).offset(,-3),resize(j-jj,4)
'  Voegt een sheet toe
      Sheets.Add
'  ??
      Sheets(1).Cells(1, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
' Verander variabele om geheel te herhalen
      jj=j
    End If
  next
End Sub
Klik om te vergroten...

dit werkt nog niet helemaal. Als ik deze namelijk ga controleren, geeft ie een foutmelding bij "for j= 1 to usedrange.columns(5).specialcells(1).count". De zin wordt geel gemarkeerd.

Zou je misschien ook kunnen vertellen wat elke regel doet? Ik heb hiertoe al een poging gedaan
 
Verwijder de regel: option Explicit
+ verbetering in vorig bericht (rood gemarkeerd)
 
Laatst bewerkt:
Ik heb de uw wijziging door gevoerd, de ''foute' regel verwijderd
en option Explicit in het script getypt.
Maar nu krijg ik de foutmelding dat het ongeldig is binnen de procedure.

Wat doe ik fout?
 
Lezen: je doet het omgekeerde van wat ik aangaf.
Nergens moet option explicit voorkomen: verwijder dat.
gebruik vervolgens de code uit mijn vorige bericht
 
Laatst bewerkt:
snb zei:
Lezen: je doet het omgekeerde van wat ik aangaf.
Nergens moet option explicit voorkomen: verwijder dat.
gebruik vervolgens de code uit mijn vorige bericht
Klik om te vergroten...


Dat was inderdaad ook wat ik dacht dat je bedoelde, maar deze zin stond nergens.
Vandaar dat ik het anderom deed.
Ik blijf nu nog de compileerfout: syntaxisfout krijgen.
 
snb zei:
Dat is een heel andere vraag.
Code: 
Sub dagsplitsing()
      sq = cells(jj,5).offset(,-3),resize(j-jj,4)
End Sub
Klik om te vergroten...

Als ik even heel eigenwijs mag zijn: Moet ,resize niet .Resize worden? (dus met een punt ipv een komma?)

Als ik dit doe dan blijft er een foutmelding komen (gele markering - object vereist-), maar de syntaxis error blijft uit.
 
Laatst bewerkt:
Dan staan er geen gegevens in kolom E (of alleen maar als resultante van formules)
 
snb zei:
Dan staan er geen gegevens in kolom E (of alleen maar als resultante van formules)
Klik om te vergroten...

In kolom E staat een cumulatieve optelling.
dus de uitkomst van de formule
E4 = D4+ E3
E5 = D5+E4 etc.

Dat was ook te zien in de bijlage van mijn eerste post.
 
Laatst bewerkt:
Wedervraag: kunnen jullie me helpen aan 30 meter ogief gefreesde glaslatten van 9 * 15 mm ?
 
Ik heb dit namelijk nodig voor het maken van een productielijst. Ik download om de zoveel tijd een excelfile uit een orderprogramma. Ik verander dus zelf niks. DE opdracht zou uitgevoerd moeten worden zodra ik daar opdracht toe geef (in de zin van op macro's klik en de handeling uit laat voeren)

Het gaat er mij om dat ik, wanneer ik de geexporteerde file open in excel, deze in eerste instantie sorteer op datum (dat is me al gelukt) en vervolgens kijk naar het aantal punten (cumulatief).
Klik om te vergroten...
Ter voorkoming van werk kun je beter die formules (kolom E) uit het blad halen (dat kan de macro zelf wel berekenen). Dan werkt mijn macro.

om hem te laten werken op kolom D:

Code: 
Sub dagsplitsing()
  jj=1
  With Sheets("xxx")
    .usedrange.columns(4).specialcells(xlcelltypeblanks).value=0
    for j= 1 to .usedrange.columns(4).specialcells(2).count
      If WorksheetFunction.Sum(.cells(jj,5).resize(j-jj)) > 990 Then
        sq = .cells(jj,5).offset(,-2).resize(j-jj,2)
        Sheets.Add
        Sheets(1).Cells(1, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
        jj=j
      End If
    next
  end with
End Sub

PS. ik dacht dat dat de business van Horjus was.
 
Laatst bewerkt:
snb zei:
Ter voorkoming van werk kun je beter die formules (kolom E) uit het blad halen (dat kan de macro zelf wel berekenen). Dan werkt mijn macro.

om hem te laten werken op kolom D:

Code: 
Sub dagsplitsing()
  jj=1
  With Sheets("xxx")
    .usedrange.columns(4).specialcells(xlcelltypeblanks).value=0
    for j= 1 to .usedrange.columns(4).specialcells(2).count
      If WorksheetFunction.Sum(.cells(jj,5).resize(j-jj)) > 990 Then
        sq = .cells(jj,5).offset(,-2).resize(j-jj,2)
        Sheets.Add
        Sheets(1).Cells(1, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
        jj=j
      End If
    next
  end with
End Sub

PS. ik dacht dat dat de business van Horjus was.
Klik om te vergroten...

Vreemd, ik krijg het niet voor elkaar. Er blijft een foutmelding komen.
Werkt het bij u wel?

PS. Nee. Hoe komt u bij Horjus?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan