• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Formules niet doortrekken naar beneden

Status
Niet open voor verdere reacties.

toverkamp

Gebruiker
Lid geworden
11 sep 2006
Berichten
403
Ik was een nieuwe vraag begonnen in een bestaand topic, maar ik denk dat het wat duidelijker is om een nieuwe vraag te beginnen.

Mijn probleem:
ik heb 2 werkbladen. Op het ene werkblad komen alle gegevens te staan. En in werkblad 2 komen alleen de gegevens te staan als er in een kolom "nee" staat. Nu moet ik alle formules in werkblad 2 doortrekken om ervoor te zorgen dat allee nee's 'gepakt' worden. Is het mogelijk met een andere (vba)code ervoor te zorgen dat ik de formules niet hoef door te trekken naar beneden, maar alleen de gegevens er neer zet als er een nee staat?

ps.
zie de bijlage, daar heb ik een voorbeeldje gemaakt wat het helemaal duidelijk maakt!
 

Bijlagen

Waarom niet met een loop controleren of in je regel een nee staat en deze dan over laten zetten? of is dit nu erg kort door de bocht?

Groet,
Ferenc
 
Waarom niet met een loop controleren of in je regel een nee staat en deze dan over laten zetten? of is dit nu erg kort door de bocht?

Groet,
Ferenc

Ja dat zou kunnen, maar ik weet niet precies hoe het werkt. Misschien dat je mij een opzetje kan geven?
 
Demeter, bedankt voor uw reactie!

Ik krijg helaas een foutmelding (zie bijlage)...
 

Bijlagen

  • formulesdoortrekken.JPG
    formulesdoortrekken.JPG
    54,4 KB · Weergaven: 56
Toverkamp,

Als je dit gedeelte weg laat doet hij het ook.
het wordt dan:
Code:
Range("A1", "G" & lastrow).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Volgens mij is dit een stukje code wat alleen vanaf excel2003 werkt.
Heb jij toevallig een andere versie?

Groet,
Ferenc
 
Toverkamp,

Als je dit gedeelte weg laat doet hij het ook.
het wordt dan:
Code:
Range("A1", "G" & lastrow).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Volgens mij is dit een stukje code wat alleen vanaf excel2003 werkt.
Heb jij toevallig een andere versie?

Groet,
Ferenc

Ferenc,
Het werk nu wel goed, met jou aanpassingen. Maar dit is niet helemaal wat ik bedoel, want nu worden de waarden "nee" echt naar een ander werkblad geschreven, maar het is de bedoeling dat de waarden wel op het ene werkblad blijven staan (daar staan dus de "ja's" en de "nee's". En op het andere werkblad komen alleen de "nee's" te staan.

ps. ik gebruik excel2000
 
Toverkamp,

Verander in de gegeven code het woord 'cut' met het woord 'copy'.
Volgens mij moet hij nu gaan doen wat jij precies bedoelt :D
Tevens kan dan je sorteerfilter eruit worden gelaten.

Code:
Sub overzetten_nee()
Dim c As Range
Dim lastrow As Long
Dim laatsteregel As Long

lastrow = Range("A" & Rows.Count).End(xlUp).Row

laatsteregel = Worksheets("nee").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("nee").Range("A2", "G" & laatsteregel).Delete

For Each c In Range("G2", "G" & lastrow)
    If c = "nee" Then
        laatsteregel = Worksheets("nee").Range("A" & Rows.Count).End(xlUp).Row + 1
        c.EntireRow.Copy Worksheets("nee").Range("A" & laatsteregel)
    End If
Next
        
End Sub

Groet,
Ferenc
 
Laatst bewerkt:
Ferenc, bedankt voor uw hulp!!
Nu komt helaas de welbekende maarrrr.....

Ik wil deze code implementeren in mijn 'echte' bestand. De macro moet achter de button op het hoofdmenu komen. Via deze button ga je dan naar het werkblad "onbeschikbaar". In dit werkblad komen alle nee's te staan. Deze nee's worden opgehaald vanuit wat in het voorbeeld "totaal" is, maar in mijn echte bestand "reactietijden". Maar dat weet excel natuurlijk niet. Wat moet ik aan de code aanpassen om deze gegevens vanuit het werkblad "reactietijden" te kopieren naar "onbeschikbaar".

Tevens zijn de kolommen niet gelijk, in het werkblad "reactietijden" staan er veel hulpkolommen voor berekeningen die in het werkblad "onbeschikbaar" niet nodig zijn. Hier hoeven echter alleen maar de gegevens gekopieerd te worden. De berekening zijn immers al gedaan in het werkblad "reactietijden".
 
Wil je een n-aantal kolommen kopieeren of de gehele rij? alleen dan zonder formules?

Groet,
Ferenc
 
Het is de bedoeling om een aantal kolommen te kopieren naar een ander werkblad, maar dit mogen dan alleen de gegevens zijn waar "nee" in staat.

Het werkblad "reactietijden" gaat van Range (B), Range (BC). Van dit werkblad moeten alleen de kolommen:
B, E, F, H, S, W, Y, Z, AA en AB gekopieerd worden naar het werkblad "onbeschikbaar.

Dus als in AP10 van werkblad "reactietijden" nee staat, moeten de gegevens uit rij10 uit de bovenstaande kolommen gekopieerd worden. Dit geldt dus voor alle "nee's" uit AP.
 
Mogen de gegevens uit de juiste kolommen naast elkaar worden geplaatst?
B, E, F, H, S, W, Y, Z, AA en AB
wordt
A, B, C, enz.

Groet,
Ferenc

ps.
Probeer deze code eens, is voor de gehele rij:
Code:
Sub overzetten_nee()
Dim c As Range
Dim lastrow As Long
Dim laatsteregel As Long

Set MyRangeI = Worksheets("reactietijden")
Set MyRangeII = Worksheets("onbeschikbaar")

lastrow = MyRangeI.Range("A" & Rows.Count).End(xlUp).Row

laatsteregel = MyRangeII.Range("A" & Rows.Count).End(xlUp).Row + 1
MyRangeII.Range("A2", "G" & laatsteregel).Delete

For Each c In MyRangeI.Range("G2", "G" & lastrow)
    If c = "nee" Then
        laatsteregel = MyRangeII.Range("A" & Rows.Count).End(xlUp).Row + 1
        c.EntireRow.Copy
        MyRangeII.Range("A" & laatsteregel).PasteSpecial Paste:=xlPasteValues
    End If
Next

MyRangeII.Select
  
End Sub
 
Toverkamp,

Om je gegevens vanuit de jusite kolommen naast elkaar te krijgen:
Code:
Sub overzetten_nee2()
Dim c As Range
Dim lastrow As Long
Dim laatsteregel As Long

Set MyRangeI = Worksheets("reactietijden")
Set MyRangeII = Worksheets("onbeschikbaar")

lastrow = MyRangeI.Range("AP" & Rows.Count).End(xlUp).Row

laatsteregel = MyRangeII.Range("A" & Rows.Count).End(xlUp).Row + 1
MyRangeII.Range("A2", "M" & laatsteregel).Delete

'Controle woord 'nee' in de cellen van bereik Kolom AP2 t/m laatst gevulde rij
For Each c In MyRangeI.Range("AP2", "AP" & lastrow)
    'als inhoudt cel nee is dan
    If c = "nee" Then
        
        'Wat is de eerste lege regel in blad 'onbeschikbaar' om gegevens te plakken.
        laatsteregel = MyRangeII.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        'Kopieer gegevens naar kolom = van kolom
        MyRangeII.Range("A" & laatsteregel) = c.Offset(, -40).Value
        MyRangeII.Range("B" & laatsteregel) = c.Offset(, -37).Value
        MyRangeII.Range("C" & laatsteregel) = c.Offset(, -36).Value
        MyRangeII.Range("D" & laatsteregel) = c.Offset(, -34).Value
        MyRangeII.Range("E" & laatsteregel) = c.Offset(, -23).Value
        MyRangeII.Range("F" & laatsteregel) = c.Offset(, -18).Value
        MyRangeII.Range("G" & laatsteregel) = c.Offset(, -17).Value
        MyRangeII.Range("H" & laatsteregel) = c.Offset(, -16).Value
        MyRangeII.Range("I" & laatsteregel) = c.Offset(, -15).Value
        MyRangeII.Range("J" & laatsteregel) = c.Offset(, -14).Value
        
    End If
Next

MyRangeII.Select
  
End Sub

Succes.

Groet,
Ferenc

ps/
Letop deze sub heeft een iets andere naam
 
Ik heb een voorbeeldbestandje toegevoegd, waar het duidelijk is hoe het eruit moet zien komen. In het werkblad "onbeschikbaar" zie je hoe de situatie nu is.
 

Bijlagen

Toverkamp,

Probeer deze eens:
Code:
Sub overzetten_nee2()
Dim c As Range
Dim lastrow As Long
Dim laatsteregel As Long

Set MyRangeI = Worksheets("reactietijden")
Set MyRangeII = Worksheets("onbeschikbaar")

Application.ScreenUpdating = False

MyRangeII.Select
Selection.AutoFilter

lastrow = MyRangeI.Range("AP" & Rows.Count).End(xlUp).Row

laatsteregel = MyRangeII.Range("B" & Rows.Count).End(xlUp).Row + 1
MyRangeII.Range("B5", "M" & laatsteregel).Delete

'Controle woord 'nee' in de cellen van bereik Kolom AP2 t/m laatst gevulde rij
For Each c In MyRangeI.Range("AP5", "AP" & lastrow)
    'als inhoudt cel nee is dan
    If c = "Nee" Or c = "NEE" Or c = "nee" Then
        
        'Wat is de eerste lege regel in blad 'onbeschikbaar' om gegevens te plakken.
        laatsteregel = MyRangeII.Range("B" & Rows.Count).End(xlUp).Row + 1
        
        'geef de cel in kolom i de opmaak 'tekst'
        MyRangeII.Range("I" & laatsteregel).NumberFormat = "@"

        'Kopieer gegevens naar kolom = van kolom
        MyRangeII.Range("B" & laatsteregel) = c.Offset(, -40).Value
        MyRangeII.Range("C" & laatsteregel) = c.Offset(, -37).Value
        MyRangeII.Range("D" & laatsteregel) = c.Offset(, -36).Value
        MyRangeII.Range("E" & laatsteregel) = c.Offset(, -34).Value
        MyRangeII.Range("F" & laatsteregel) = c.Offset(, -23).Value
        MyRangeII.Range("G" & laatsteregel) = c.Offset(, -19).Value
        MyRangeII.Range("H" & laatsteregel) = c.Offset(, -17).Value
        MyRangeII.Range("I" & laatsteregel) = c.Offset(, -16).Value
        MyRangeII.Range("J" & laatsteregel) = c.Offset(, -15).Value
        MyRangeII.Range("K" & laatsteregel) = c.Offset(, -14).Value
        MyRangeII.Range("L" & laatsteregel) = c.Offset(, -2).Value
    End If
Next

MyRangeII.Range("B4:L4").Select
Selection.AutoFilter

MyRangeII.Range("A1").Select

Application.ScreenUpdating = True
    
End Sub

Groet,
Ferenc
 
Laatst bewerkt:
Ferenc,

het werkt super!! Echt hardstikke bedankt! M'n bestand is weer 3 MB kleiner:D :thumb:

Update:
Ik zie dat de opmaak niet goed meeveranderd.
De opmaak moet er als volgt uit komen zien:
- kolom c: tijd 13:30
- kolom g: tijd 13:30
- kolom h: tijd 13:30
- kolom k: :mm
- kolom l: :mm
 
Laatst bewerkt:
Graag gedaan, ben zelf ook met zoiets bezig geweest afgelopen week.
Mmmmmmmm, komt me bekend voor :D .

Is een goede test om te kijken of ik het zelf ook enigzins snap wat ik hier op het forum heb opgestoken.
En last but not least, zo helpen we elkaar weer hier op het forum.

Groet,
Ferenc
 
zie mijn aanpassingen.
Ik ben er gedeeltelijk uitgekomen:
Code:
        'geef de cel in kolom i de opmaak 'tekst'
        MyRangeII.Range("I" & laatsteregel).NumberFormat = "@"
        MyRangeII.Range("c" & laatsteregel).NumberFormat = "hh:mm"
        MyRangeII.Range("g" & laatsteregel).NumberFormat = "hh:mm"
        MyRangeII.Range("h" & laatsteregel).NumberFormat = "hh:mm"

het probleem is alleen dat de numberformat :mm niet herkend. Deze format ben ik echter wel nodig omdat er ook meer dan 24 uren voor kunnen komen.
 
ik ben er uit. Ik had de nederlandse opmaak, maar deze moest in engels. ipv :mm komt er te staan:
Code:
MyRangeII.Range("i" & laatsteregel).NumberFormat = "[h]:mm"
 
Toverkamp,

Bedankt voor je zelf gevonden antwoord, daar hebben we met zijn allen ook wat aan.
En scheelt weer wat werk. :).

Groet,
Ferenc
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan