lotto2

[don42]

Ik heb al een vraag gesteld over deze lotto
maar Bekijk bijlage Lotto1 .xlsmdeze heb ik gesloten
weet niet wat nu niet of ik de oude vraag moet heropenen
of een nieuwe vraag stellen
ik heb dus gekozen voor de laatste optie

wie kan mij helpen deze code om te zetten naar vba

=ALS(AANTAL($C7:$L7)<10;"";SOMPRODUCT(N(AANTAL.ALS(P$7:U$36;C7:L7)>0)))

zou graag zien dat deze code in een loop (zoveel als er deelnemers zijn - kolom b tabblad Lotto)
de formule staat nu in cel m7 tot m36
Bekijk bijlage Lotto1 .xlsm
don

 

[VenA]

Waarom een combinatie van formules en VBA?

Om aan de vraag te voldoen kan je deze proberen.

Sub VenA()
With Sheets("Lotto").[M7]
    .FormulaR1C1 = "=IF(COUNT(RC3:RC12)<10,"""",SUMPRODUCT(N(COUNTIF(R7C[3]:R36C[8],RC[-10]:RC[-1])>0)))"
    .AutoFill .Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6)
End With
End Sub

 

[HSV]

Of:

Sub hsv()
Sheets("Lotto").Range("M7").Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6) = "=IF(COUNT(RC3:RC12)<10,"""",SUMPRODUCT(N(COUNTIF(R7C[3]:R36C[8],RC[-10]:RC[-1])>0)))"
End Sub

 

[don42]

Beste
bedankt voor de hulp, beide opties werken prima
ik zie alleen dat het vertragend werkt dat is jammer (is dat op te lossen?)
op de vraag waarom de combi vba en formules. Ik zou natuurlijk het liefst de hele lotto in vba hebben
dus daar moet ik nog aan sleutelen

 

[HSV]

Waarschijnlijk heb je een trage Pc.
Ik kan het niet afkijken of het staat er al.

Plaats onderstaande coderegel bovenaan in de code.

application.screenupdating = false

 

[don42]

Lotto naar vba

Dat maakt weinig verschil (of ik doe iets verkeerd)
heb het bestandje erbij gedaan
Bekijk bijlage Lotto1 .xlsm

 

[don42]

waarom werkt 2 x with niet?

Ben nog steeds aan het puzzelen met mijn lotto (wil graag alles in VBA)
beide codes hieronder werken (apart van elkaar maar niet in combi)
hoe moet ik dit aanpassen

With Sheets("Lotto").[M7]
    .FormulaR1C1 = "=IF(COUNT(RC3:RC12)<10,"""",SUMPRODUCT(N(COUNTIF(R7C[3]:R36C[8],RC[-10]:RC[-1])>0)))"
    .AutoFill .Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6)
    End With

 With Sheets("Lotto").[N7]
    .FormulaR1C1 = "=IF(RC[-1]=10,""Winnaar"","""")"
    .AutoFill .Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6)
End With

Don

 

[VenA]

Jouw bestand kan nooit werken.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("o7:o36").ClearContents

Blijf zichzelf steeds aanroepen wat in een vastloper zal resulteren.

Waarom wil je bij elke celaanwijzing het werkblad opnieuw vullen met formules en al het andere wat de code zou moeten doen?

Gebruik in iedergeval zoiets

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [P7:U36]) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    MsgBox "mijn code"
    Application.EnableEvents = True
End If
End Sub

 

[don42]

VenA
Ongetwijfeld goed bedoeld, maar dit snap ik even niet

 

[HSV]

De 'autofill' methode is een derde langzamer dan die ene regel die ik plaatste, maar daar ligt het niet zozeer aan.
Die selection_change met de 'Do - Loop' er uit, en dan is onderstaande vele malen sneller.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [p7:u36]) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
 With Sheets("Lotto")
  .[o7:o36].ClearContents
  .[m7].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6) = "=IF(COUNT(RC3:RC12)<10,"""",SUMPRODUCT(N(COUNTIF(R7C[3]:R36C[8],RC[-10]:RC[-1])>0)))"
    If .[p7] > 0 Then
      .[o7].Value = Sheets("Betalingen").Range("t1")
        With .[o8].Resize(Cells(Rows.Count, 16).End(xlUp).Row - 7)
         .Formula = "=r[-1]c + 7"
         .Value = .Value
        End With
    End If
 End With
Application.EnableEvents = True
End If
End Sub

 

[don42]

Wat gaat er fout

heb de code geplakt maar werkt niet
Bekijk bijlage Lotto1 .xlsm
hieronder het blad zonder VBA
Bekijk bijlage Lotto-db2 .xlsx Kijk aub even naar dit blad (het werkt goed en dit wil ik heel graag in vba)

Don

 

[HSV]

Test het zo maar eens weer, en geef aub aan waar het fout gaat ipv van de code werkt niet.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [p7:u36]) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
  [o7:o36].ClearContents
  [m7].Resize(Cells(Rows.Count, 2).End(xlUp).Row - 6) = "=IF(COUNT(RC3:RC12)<10,"""",SUMPRODUCT(N(COUNTIF(R7C[3]:R36C[8],RC[-10]:RC[-1])>0)))"
    If [p7] > 0 Then
       [o7].Value = Sheets("Betalingen").Range("t1")
       If Target.Row > 7 Then
        With Cells(8, 15).Resize(Target.Row - 7)
         .Formula = "=r[-1]c + 7"
         .Value = .Value
        End With
       End If
    End If
Application.EnableEvents = True
End If
End Sub

 

[don42]

Hoi HSV
Ik zal de volgende duidelijker zijn
en melden wat de een eventuele foutmelding is
Over de laatste code heb ik maar 1 opmerking
Hij werkt perfect.
Bedankt maar weer eens.