bepaalde kolommen kopieren na voldaan voorwaarde

[VenA]

Het was handig geweest als je een nieuw bestand had geplaatst met de gewenste formule. Zet de weergaven van de formules op R1C1 reference style

In de array kan je deze dan zetten. Geen idee wat jouw formule moet doen dus maar even zo

Blad24.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Array(.Cells(j, 1), .Cells(j, 2), .Cells(j, 3), .Cells(j, 4), .Cells(j, 7), .Cells(j, 9), "=rc[-1]")

 

[maomanna]

in R1K1 is het:

Blad24.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 16) = Array(.Cells(j, 1), .Cells(j, 2), .Cells(j, 3), .Cells(j, 4), , .Cells(j, 7), .Cells(j, 9), "x", "x", "x", "x", "x", "x", "x", "x", .Cells(j, 10), "", "", "", "=IF(OR(AND(RK4=""Ja"";RK5=""Ja"";RK21=8);AND(RK4=""Nee"";RK5="""";RK21=8));""compleet"";""incompleet"")")

helaas werkt het niet
zal maandag een voorbeeldbestand toevoegen

 

[HSV]

Je zal minimaal de resize op 20 moeten zetten, en dan maar hopen.

 

[VenA]

VBA is in het Engels dus ; is , en K = C

om te testen met een iets andere formule

Cells(10, 20) = "=IF(AND(RC[1]=8,AND(OR(COUNTIF(RC[-16]:RC[-15],""Ja"")=2,AND(RC[-16]=""nee"",RC[-15]="""")))),""compleet"",""incompleet"")"

 

[maomanna]

Hierbij het nieuwe voorbeeldbestand.
Bekijk bijlage nieuw_test.xlsm

Hij voert de formule nu uit. maar plaatst alleen de uitkomst van de formule en niet de formule zelf.

 

[VenA]

Zo beter?

 

[maomanna]

Zo beter?

Jazeker! zie ook dat de formule iets anders in elkaar zit.
Het is dus niet zo dat ik de R1C1 formule zo kan copy/pasten.

ik had verwacht dat ik het na de eerste formule wel zelf kon.
Helaas kan ik niet zo snel vinden hoe ik goede R1C1 formules kan maken.
In de cel ernaast wil ik uiteindelijk dit hebben:

"=COUNTA(RC[-13]:RC[-6])-(COUNTIF(RC[-13]:RC[-6];""x"")+COUNTIF(RC[-13]:RC[-6];""nvt"")"

Nu geeft hij bij de eerste [-13] aan dat hij een scheidingsteken of ) verwacht.de resize vooraan staat op 21.

edit:

        Blad24.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21) = Array(.Cells(j, 1), .Cells(j, 2), .Cells(j, 3), .Cells(j, 4), , .Cells(j, 7), .Cells(j, 9), "x", "x", "x", "x", "x", "x", "x", "x", .Cells(j, 10), "", "", "", "=IF(AND(RC[1]=8,AND(OR(COUNTIF(RC[-16]:RC[-15],""Ja"")=2,AND(RC[-16]=""nee"",RC[-15]="""")))),""compleet"",""incompleet"")", "=COUNTA((RC[-13]:RC[-6]))")

werkt wel, alleen de vergelijking met "X" en "nvt" niet..

Blad24.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21) = Array(.Cells(j, 1), .Cells(j, 2), .Cells(j, 3), .Cells(j, 4), , .Cells(j, 7), .Cells(j, 9), "x", "x", "x", "x", "x", "x", "x", "x", .Cells(j, 10), "", "", "", "=IF(AND(RC[1]=8,AND(OR(COUNTIF(RC[-16]:RC[-15],""Ja"")=2,AND(RC[-16]=""nee"",RC[-15]="""")))),""compleet"",""incompleet"")", "=COUNTA((RC[-13]:RC[-6]),(COUNTIF(RC[-13]:RC[-6],""x""),(COUNTIF(RC[-13]:RC[-6],""nvt"")")

 

[VenA]

Niet direct toepasbaar in de array maar dat mag hopelijk wel duidelijk zijn.

Sub VenA()
  Cells(10, 21) = "=COUNTA(RC[-13]:RC[-6])-COUNTIF(RC[-13]:RC[-6],""x"")+COUNTIF(RC[-13]:RC[-6],""nvt"")"
End Sub

Geeft in U10 de excelformule waarna je opzoek bent.

 

[maomanna]

Niet direct toepasbaar in de array maar dat mag hopelijk wel duidelijk zijn.

Sub VenA()
  Cells(10, 21) = "=COUNTA(RC[-13]:RC[-6])-COUNTIF(RC[-13]:RC[-6],""x"")+COUNTIF(RC[-13]:RC[-6],""nvt"")"
End Sub

Geeft in U10 de excelformule waarna je opzoek bent.

ik was er inderdaad achter dat het niet in de array kon. snap alleen niet waarom

Met je oplossing, ben ik verder gaan stoeien.

nu heb ik

Sub Telaantallen()
Application.EnableEvents = False
 Dim j As Long
    With Blad24
        For j = .Columns(9).SpecialCells(2).Count To 2 Step -1
            Cells(j, 21).Formula = "=COUNTA(RC[-13]:RC[-6])-COUNTIF(RC[-13]:RC[-6],""x"")+COUNTIF(RC[-13]:RC[-6],""nvt"")"
        Next j
  End With
Application.EnableEvents = True
End Sub

in het blad24 bij Worksheet_change deze toegevoegd.
Nu lijkt hij goed te werken.

Dank je wel!

 

[HSV]

Werkt gewoon hoor (even de formule uitkomst daargelaten).

Private Sub Voltooiden_Click() 
Dim j As Long
   'Formulierretour
application.screenupdating = false
Application.EnableEvents = False

With Sheets("aanmeldingen 2017")
  For j = .Columns(9).SpecialCells(2).Count To 2 Step -1
    If LCase(.Cells(j, 9)) <> "x" Then
        Sheets("lopend 2017").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21) = Array(.Cells(j, 1).Value, .Cells(j, 2).Value, _
        .Cells(j, 3).Value, .Cells(j, 4).Value, , .Cells(j, 7).Value, .Cells(j, 9).Value, "x", "x", "x", "x", "x", "x", "x", "x", _
        .Cells(j, 10).Value, "", "", "", "=IF(AND(RC[1]=8,AND(OR(COUNTIF(RC[-16]:RC[-15],""Ja"")=2,AND(RC[-16]=""nee"",RC[-15]="""")))),""compleet"",""incompleet"")", "=COUNTA(RC[-13]:RC[-6])-COUNTIF(RC[-13]:RC[-6],""x"")+COUNTIF(RC[-13]:RC[-6],""nvt"")")
       .Rows(j).Delete
    End If
  Next j
End With
Application.EnableEvents = True
End Sub

 

[maomanna]

Op basis van voorgaande codes voor het toevoegen van formules heb ik de volgende sub gemaakt.

Sub Extra_velden()
Application.EnableEvents = False
 Dim j As Long
    With Blad24
        For j = .Columns(1).SpecialCells(2).Count To 2 Step -1
            Cells(j, 18).Formula = "=DATEDIF(TODAY(),RC[-1],""d"")"
            Cells(j, 21).Formula = "=IF(AND(RC[1]=8,AND(OR(COUNTIF(RC[-16]:RC[-15],""Ja"")=2,AND(RC[-16]=""nee"",RC[-15]="""")))),""compleet"",""incompleet"")"
            Cells(j, 22).Formula = "=COUNTA(RC[-13]:RC[-6])-COUNTIF(RC[-13]:RC[-6],""x"")"
            Cells(j, 25) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 26) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 27) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 28) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 29) = "=IF(OR(RC[-12]<>""x"",RC[-12]<>""zsm""), MONTH(RC[-12]),""Nog niet bekend"")"
        Next j
  End With
Application.EnableEvents = True
End Sub

Die macro voert hij uit bij elke worksheet_change ().

wel wat traag, maar het werkt. (indien andere manier, met bijv controle op de reeds ingevulde velden, is natuurlijk altijd welkom)

Het punt alleen is dat hij bij de onderste twee regels, de macro's niet uitvoert.
komt dat door die?

For j = .Columns(1).SpecialCells(2).Count [B]To 2 Step -1[/B]

 

[HSV]

Voeg er eens een 'application.enableevent = false' aan toe.

en onderstaand kan korter, maar of het sneller wordt???

Cells(j, 25) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 26) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 27) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 28) = "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"
            Cells(j, 29) = "=IF(OR(RC[-12]<>""x"",RC[-12]<>""zsm""), MONTH(RC[-12]),""Nog niet bekend"")"

Cells(j, 25)[COLOR="#FF0000"].resize(,5) [/COLOR]= "=IF(OR(RC[-17]<>""x"",RC[-17]<>""nvt""), MONTH(RC[-17]),""Nog niet bekend"")"