If Then Else probleem!

[pd1lg]

Bekijk bijlage Federatie2017.xlsb

De formule die in dit excel bestand staat is een keer gemaakt door iemand op de forum.
Nu ben ik er zelf mee aan het knutselen om het zodanig te maken dat alleen de scores van NBR worden opgeslagen in Totaal.
Volgens mij moet het kunnen met If H4 = "NBR" Then voor de thuiswedstrijd, en met Else voor de uitwedstrijd.
Maar ik krijg steeds een foutmelding. Ik heb de End If op verschillende plaatsen geprobeerd.

Misschien wil iemand van jullie kijken wat ik verkeerd doe.

 

[Jack Nouws]

Zo misschien

Sub CmdscoreNtotaal_Click()
Dim col As Long, r As Long, week As String, speler As Integer
week = "W" & Sheets("Invoer").Range("E4") 'W en nr samenvoegen
Application.ScreenUpdating = False
With Sheets("Totaal")
    col = WorksheetFunction.Match((week), .Range("a6", "bz6"), 0) 'weeknr
End With
With Sheets("Invoer")
       If .Range("H4") = "NBR" Then 'Voor uit of thuis'
    For Each cl In .Range("J9", "J19") 'CL = gemaakte caramboles
        On Error Resume Next
    If cl.Value > 0 Then
        speler = cl.Offset(0, -3).Value
    With Sheets("Totaal")
        r = WorksheetFunction.Match((speler), .Range("E1", "E100"), 0) 'speler nr
        End With
        cl.Copy
        With Sheets("Totaal").Cells(r - 0, col)
            .PasteSpecial Paste:=(xlValues)
        End With
'        cl.Offset(0, 2).Copy
'        With Sheets("Totaal").Cells(r + 1, col)
'            .PasteSpecial Paste:=(xlValues)
'        End With
    End If
    Next
'       End If 'Voor uit of thuis'
Else
    
'With Sheets("Invoer")
'       If H4 = "NBR" Then 'Voor uit of thuis'
    For Each cl In .Range("Q9", "Q19")
        On Error Resume Next
    If cl.Value > 0 Then
        speler = cl.Offset(0, -3).Value
        With Sheets("Totaal")
            r = WorksheetFunction.Match((speler), .Range("E1", "E100"), 0)
        End With
        cl.Copy
        With Sheets("Totaal").Cells(r - 0, col)
            .PasteSpecial Paste:=(xlValues)
        End With
 '       cl.Offset(0, 2).Copy
 '       With Sheets("Totaal").Cells(r + 1, col)
 '           .PasteSpecial Paste:=(xlValues)
 '       End With
    End If
    Next
        End If 'Voor uit of thuis'
End With
    
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
End Sub

 

[pd1lg]

Hallo Jack, dank voor je reactie.
Ik ben weer blij met de oplossing. :thumb:

 

[VenA]

Is dit niet voldoende

Sub VenA()
Dim j As Long, ar
  ar = Sheets("Invoer").Cells(9, 7).Offset(, (Abs(LCase(Sheets("Invoer").Range("O4")) = "nbr")) * 7).Resize(11, 4)
  For j = 1 To UBound(ar)
    If ar(j, 4) <> "" Then Sheets("Totaal").Cells(Application.Match(ar(j, 1), Sheets("Totaal").Columns(5), 0), Application.Match("W" & Sheets("Invoer").[E4], Sheets("Totaal").Rows(6), 0)) = ar(j, 4)
  Next j
End Sub

 

[pd1lg]

Bekijk bijlage Federatie2017.xlsb

Hier een update van mijn programma.
De formule van VenA werkt prima, maar ik heb de formule nu voor drie bladen gebruikt.
De drie bladen zijn WB1, WB2 en WB3. WB1 en WB2 werken goed, maar WB3 geeft een foutmelding 'Typen komen niet met elkaar overeen.'
En de scores van WB3 komen niet op de juiste plaats. Zou kunnen dat dit aan de melding ligt?

Zou je misschien nog een keer willen kijken wat ik nu weer verkeert heb gedaan. Ik ben in de formule aan het zoeken, maar kan niets verkeerd vinden.
De For/Next loop doet het 7 keer goed, en dan gaat het fout.

 

[VenA]

Maak eerst even duidelijk wat het moet worden. Je laat blijkbaar ook verschillende teams van dezelfde club tegen elkaar spelen en dan werkt de code natuurlijk niet. De foutmelding krijg je omdat speler 35 niet gevonden wordt.

LCase(Sheets("WB3").Range("O4")) = "NBR"

zal nooit waar worden en "NBR 1" is wat anders dan "NBR". In de ander bladen zal de code dus ook niet werken ook al beweer je van wel.

 

[snb]

Kolommen verbergen is ook niet echt handig.

En verkeert is echt verkeerd.

 

[VenA]

Hoewel al gesteld in de eerste zin van #6, toch nog een additionele vraag;

Wat moet er gebeuren als dezelfde speler 2 of meer partijen in dezelfde week speelt?

25 L. Welink 19 24 5 3 - 29 N. van der Zwet 20 23 1
25 L. Welink 19 16 -3 0 - 29 N. van der Zwet 20 31 3

 

[pd1lg]

Kolommen verbergen is ook niet echt handig.

En verkeert is echt verkeerd.

Waarom is kolommen verbergen niet handig?

Grappig dat men over mijn taal voutje valt.

 

[pd1lg]

Maak eerst even duidelijk wat het moet worden. Je laat blijkbaar ook verschillende teams van dezelfde club tegen elkaar spelen en dan werkt de code natuurlijk niet. De foutmelding krijg je omdat speler 35 niet gevonden wordt.

LCase(Sheets("WB3").Range("O4")) = "NBR"

zal nooit waar worden en "NBR 1" is wat anders dan "NBR". In de ander bladen zal de code dus ook niet werken ook al beweer je van wel.

Sorry. Het is ook behoorlijk stom van mij om juist de scores te pakken van dubbele spelers en teams. Dit komt maar 2 keer per jaar voor. Was de bedoeling om dit handmatig in te voeren.
Bij het invoeren van het score formulier van WB1, WB2 en WB3 worden nooit fouten gemaakt, maar bij het invullen van het totaal formulier gaat het elke week fout.
Daarom wilde ik dit graag automatisch laten gebeuren. En ik met mijn simpel verstand dacht met 1 formule het op te lossen.

De bedoeling is dat de scores van WB1, WB2 en WB3 in Totaal komen te staan. twee keer per jaar spelen WB1 en WB2 tegen elkaar omdat ze in dezelfde klasse spelen.
Ook komt het wel eens voor dat een team te weinig spelers heeft, en iemand twee keer moet spelen.

 

[VenA]

Het volledig quoten van een reactie is niet nodig.

Het verbergen van kolommen in een voorbeeldbestand is niet handig omdat het visueel lijkt dat je een offset van 5 kolommen nodig hebt terwijl dit in werkelijkheid 7 is. Hetzelfde geldt voor de onnodige samengevoegde cellen. Het wordt dan een beetje niets is wat het lijkt en is vervelend als je redelijk voor de vuist weg wat code maakt en het bij het testen niet werkt.

Als je een macro start dmv een knop hoef je niet te verwijzen naar een bepaalde tab. De code kan je beter in een gewone module plaatsen.

Aangezien een speler meerdere keren kan voorkomen worden de punten opgeteld. Om dubbelingen te voorkomen worden de scores na het klikken op de knop gewist. Dus test het maar weer even.

Sub VenA()
Dim j As Long, jj As Long, r As Range, ar
  ar = Range("G4:S" & Cells(Rows.Count, 7).End(xlUp).Row)
  For jj = 2 To UBound(ar, 2) Step 7
    If LCase(Left(ar(1, jj), 3)) = "nbr" Then
      For j = 6 To UBound(ar)
        If ar(j, jj + 2) <> "" Then
          Set r = Sheets("Totaal").Cells(Application.Match(ar(j, jj - 1), Sheets("Totaal").Columns(5), 0), Application.Match("W" & [E4], Sheets("Totaal").Rows(6), 0))
          r.Value = r.Value + ar(j, jj + 2)
        End If
      Next j
    End If
  Next jj
  On Error Resume Next
  Range("J:J,Q:Q").SpecialCells(2, 1).ClearContents
End Sub

 

[pd1lg]

Ik heb de 26 weken opnieuw ingevoerd, en de formule werkt heel goed. Alleen het bij elkaar optellen als een speler twee maal speelt moet in de gaten worden gehouden.

Maar echt top gedaan VenA, dank je wel voor het werkt dat je eraan besteed hebt.

 

[VenA]

Je kan eventueel een controle inbouwen om te kijken of een speler al punten heeft in de betreffende week.

If r.Value = "" Then r.Value = r.Value + ar(j, jj + 2) Else r.Value = r.Value + IIf(MsgBox("Speler " & ar(j, jj) & "heeft al punten doorgaan?", vbYesNo, "Controle") = vbYes, ar(j, jj + 2), 0)

 

[pd1lg]

Ik heb de regel r.Value = r.Value + ar(j, jj + 2) vervangen door de boven stande regel.

Dank je wel VenA

 

[VenA]

Graag gedaan. Als de hele handel werkt dan mag je de vraag nog even op opgelost zetten.