PNG32 PNG32 PNG32 PNG32
PNG32
Forum Excel, VBA, VSTO, Exceltips, Excelhj�lp PNG32 drivs av Excelspecialisten    Logga in     English
PNG32
PNG32 PNG32
PNG32

Logga in

PNG32

Du är inte inloggad. Logga in eller registrera dig för att skriva inlägg eller svara på inlägg.

För frågor om forumet, kontakta oss på webmaster@excelforum.se
PNG32 PNG32
PNG32 PNG32
PNG32

Excelforum

PNG32

 
ForumForumDiskussionerDiskussionerVBAVBAGruppspel, turordningGruppspel, turordning
Föregående Föregående
 
Nästa Nästa
Nytt inlägg
 2020-03-24 11:52
 
Minna

Medlem sedan: 2020-03-24
3 inlägg

Hej

Jag håller på att fippla med en gammal fil med en gruppspelsturnering. Excel varnar för fel i koden vid turordning(i, 0) = LRandomNumber men jag är verkligen inte bra på detta så jag kan inte inte riktigt lista ut vad den inte är nöjd med.

Do While i <= antalDeltag

        LRandomNumber = Int((antalDeltag - Bottom + 1) * Rnd + Bottom)

        If InStr(temp, "%" + CStr(LRandomNumber) + "%") = 0 Then

                 turordning(i, 0) = LRandomNumber

                 temp = temp + CStr(LRandomNumber) + "%"

                 i = i + 1

        End If

Anledningen till att jag grejar med detta är att jag vill kunna ha fler spelare än vad macrot tillät och nu när jag kör macrot kommer felet Subscript out of range.

Har googlat i timtal så jag är otroligt tacksam för hjälp, minsta ledtråd vore underbart!
Nytt inlägg
 2020-03-24 20:42
 
Christian

Medlem sedan: 2015-08-26
1209 inlägg
Bifoga gärna hela din kod
Mvh
Christian
Nytt inlägg
 2020-03-25 06:31
 
Minna

Medlem sedan: 2020-03-24
3 inlägg

 Public turordning(40, 1) As Integer

Public antalGrupper As Integer
Public antalDeltagare As Integer
Public antalPerGrupp(10) As Integer
Public init As Boolean
 
Sub start()
init = False
Application.ScreenUpdating = False
Worksheets("Tabell").Unprotect
Worksheets("TemplatesTabell").Visible = True
 
For h = 1 To 40
    turordning(h, 0) = 0
Next
'ResultatHead (6)
    Sheets("Tabell").Select
    Cells.Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select
    'matcher (1)
   
    'antalDeltagare = 16
    slumpa (antalDeltagare)
    
    genereraAntalGrupper
    'MsgBox CStr(antalGrupper) + "::" + CStr(antalDeltagare)
    
    grupper
    
    matcher
    
    init = True
    Application.ScreenUpdating = True
    'ActiveWindow.SelectedSheets.Visible = False
    Worksheets("TemplatesTabell").Visible = False
    
    fnuttBort
    Worksheets("Deltagare").Select
    Range("A1").Select
    
End Sub
Sub grupper()
Sheets("Tabell").Select
    Cells.Select
        Selection.ClearContents
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Selection.Interior.ColorIndex = xlNone
        
        Dim tabellplats(10) As String
        tabellplats(1) = "B2:K8"
        tabellplats(2) = "B10:K16"
        tabellplats(3) = "B18:K24"
        tabellplats(4) = "B26:K32"
        tabellplats(5) = "B34:K38"
        
        Sheets("TemplatesTabell").Select
            Range("B2:K8").Select
            Selection.Copy
            Sheets("Tabell").Select
            Range("A1").Select
            
        For t = 1 To antalGrupper
            Range(tabellplats(t)).Select
            ActiveSheet.Paste
        Next
        
        Dim start(10) As Integer
        start(1) = 4
        start(2) = 12
        start(3) = 20
        start(4) = 28
        start(5) = 34
        start(6) = 42
        r = 1
     
        
        For t = 1 To antalGrupper
           For y = 1 To antalPerGrupp(t)
                    Range("B" + CStr(y + start(t))).Select
                    ActiveCell.Formula = "=Deltagare!C" + CStr(turordning(r, 0) + 1)
                    r = r + 1
            Next
        Next
        
        
End Sub
Sub slumpa(antalDeltag)
'Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)
'    Dim LRandomNumber As Integer
'   LRandomNumber = Int((300 - 200 + 1) * Rnd + 200)
   
   'antalDeltag = 48
    
    Dim LRandomNumber As Integer
    Dim Bottom As Integer
    Dim antalGrupper As Integer
    
    antalGrupper = 12
    i = 1
    u = 1
    Bottom = 1
    
    Dim temp As String
    temp = "%"
    
    
    Do While i <= antalDeltag
        LRandomNumber = Int((antalDeltag - Bottom + 1) * Rnd + Bottom)
        
        If InStr(temp, "%" + CStr(LRandomNumber) + "%") = 0 Then
            
            turordning(i, 0) = LRandomNumber
            temp = temp + CStr(LRandomNumber) + "%"
            
            i = i + 1
        End If
        
       
        'Optimering!
        'If LRandomNumber = (Bottom + 1) Then
          '  Bottom = LRandomNumber
        'End If
         
    Loop
    
  '  MsgBox turordning(8, 0)
   ' MsgBox temp
        'titletext
        
 
        
 
End Sub
 
 Sub genereraAntalGrupper()
 
        Dim temp As Double
        Dim temp1 As Double
        
        antalGrupper = Round((antalDeltagare / 4) + 0.3)
        
        temp1 = Round((antalDeltagare / antalGrupper) - 0.3)
        temp2 = antalDeltagare - temp1 * antalGrupper
        'MsgBox temp1
        
        For y = 1 To antalGrupper
            
            antalPerGrupp(y) = temp1
            If temp2 > 0 Then
                antalPerGrupp(y) = antalPerGrupp(y) + 1
                temp2 = temp2 - 1
            End If
        Next
        
 
 End Sub
Sub matcher()
    Dim slutspelStart As Integer
    
    'Dim antalDeltagare(6)
   ' antalDeltagare(1) = 4
    'antalDeltagare(2) = 8
    'antalDeltagare(3) = 0
    'antalDeltagare(4) = 16
    'antalDeltagare(5) = 0
    'antalDeltagare(6) = 32
        Sheets("Matcher").Select
        Cells.Select
        Selection.ClearContents
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Selection.Interior.ColorIndex = xlNone
        
        Sheets("TemplatesTabell").Select
        Range("N1:S1").Select
        Selection.Copy
        Sheets("Matcher").Select
        Range("C2").Select
        ActiveSheet.Paste
        
        Sheets("TemplatesTabell").Select
        Range("M2:S2").Select
        Selection.Copy
                
        Offset = 2
        Sheets("Matcher").Select
        For z = 1 To (antalGrupper * 6)
            Range("B" + CStr(Offset + z)).Select
            ActiveSheet.Paste
        Next
        
        Dim ordning(6, 2) As Integer
        ordning(1, 1) = 1
        ordning(1, 2) = 2
        ordning(2, 1) = 3
        ordning(2, 2) = 4
        ordning(3, 1) = 1
        ordning(3, 2) = 3
        ordning(4, 1) = 2
        ordning(4, 2) = 4
        ordning(5, 1) = 1
        ordning(5, 2) = 4
        ordning(6, 1) = 2
        ordning(6, 2) = 3
        
        Dim hopp(10) As Integer
        hopp(1) = 1
        hopp(2) = 2
        hopp(3) = 3
        hopp(4) = 4
        
        Dim hopp2(5) As Integer
        hopp2(1) = 4
        hopp2(2) = 12
        hopp2(3) = 20
        hopp2(4) = 28
        
        Dim hopp3(3) As String
        hopp3(1) = "C"
        hopp3(2) = "D"
        hopp3(3) = "E"
        
        Dim count(4) As Integer
        count(1) = 0
        count(2) = 0
        count(3) = 0
        count(4) = 0
        
        
        
        'antalGrupper = 2
       For c = 1 To antalGrupper
            count(1) = 0
            count(2) = 0
            count(3) = 0
            count(4) = 0
            'Worksheets("Tabell").Activate
            temp1 = "="
            temp2 = "="
            
            For G = 1 To 6
                Worksheets("Matcher").Range("C" + CStr(Offset + hopp(c))).Value = Worksheets("Tabell").Range("B" + CStr(ordning(G, 1) + hopp2(c))).Value
                Worksheets("Matcher").Range("E" + CStr(Offset + hopp(c))).Value = Worksheets("Tabell").Range("B" + CStr(ordning(G, 2) + hopp2(c))).Value
                
                count(ordning(G, 1)) = count(ordning(G, 1)) + 1
                count(ordning(G, 2)) = count(ordning(G, 2)) + 1
                
                'Worksheets("Tabell").Range(hopp3(count(ordning(G, 1))) + CStr(ordning(G, 1) + hopp2(c))).Formula = "=Matcher!F" + CStr(Offset + hopp(c))
                'Worksheets("Tabell").Range(hopp3(count(ordning(G, 2))) + CStr(ordning(G, 2) + hopp2(c))).Formula = "=Matcher!G" + CStr(Offset + hopp(c))
                
                'Omgångar
                'Worksheets("Tabell").Range(hopp3(count(ordning(G, 1))) + CStr(ordning(G, 1) + hopp2(c))).Formula = "=OM(Matcher!F" + CStr(Offset + hopp(c)) + "=0;0;OM(Matcher!F" + CStr(Offset + hopp(c)) + "Matcher!G" + CStr(Offset + hopp(c)) + ";2;1)))"
                'Worksheets("Tabell").Range(hopp3(count(ordning(G, 2))) + CStr(ordning(G, 2) + hopp2(c))).Formula = "=OM(Matcher!F" + CStr(Offset + hopp(c)) + "=0;0;OM(Matcher!F" + CStr(Offset + hopp(c)) + "Matcher!G" + CStr(Offset + hopp(c)) + ";0;1)))"
                Worksheets("Tabell").Range(hopp3(count(ordning(G, 1))) + CStr(ordning(G, 1) + hopp2(c))).FormulaR1C1 = "=IF(Matcher!F" + CStr(Offset + hopp(c)) + "="""",0,IF(Matcher!F" + CStr(Offset + hopp(c)) + "Matcher!G" + CStr(Offset + hopp(c)) + ",2,1)))"
                Worksheets("Tabell").Range(hopp3(count(ordning(G, 2))) + CStr(ordning(G, 2) + hopp2(c))).FormulaR1C1 = "=IF(Matcher!F" + CStr(Offset + hopp(c)) + "="""",0,IF(Matcher!F" + CStr(Offset + hopp(c)) + "Matcher!G" + CStr(Offset + hopp(c)) + ",0,1)))"
                'Worksheets("Tabell").Range(hopp3(count(ordning(G, 2))) + CStr(ordning(G, 2) + hopp2(c))).Select
                'ActiveCell.FormulaR1C1 = "=IF(1>2,3,4)"
                 
                 
                'Gjorda mål
                Worksheets("Tabell").Range("G" + CStr(ordning(G, 1) + hopp2(c))).Formula = Worksheets("Tabell").Range("G" + CStr(ordning(G, 1) + hopp2(c))).Formula + "Matcher!F" + CStr(Offset + hopp(c)) + "+"
                Worksheets("Tabell").Range("G" + CStr(ordning(G, 2) + hopp2(c))).Formula = Worksheets("Tabell").Range("G" + CStr(ordning(G, 2) + hopp2(c))).Formula + "Matcher!G" + CStr(Offset + hopp(c)) + "+"
                
                'Insläppta mål
                Worksheets("Tabell").Range("H" + CStr(ordning(G, 1) + hopp2(c))).Formula = Worksheets("Tabell").Range("H" + CStr(ordning(G, 1) + hopp2(c))).Formula + "Matcher!G" + CStr(Offset + hopp(c)) + "+"
                Worksheets("Tabell").Range("H" + CStr(ordning(G, 2) + hopp2(c))).Formula = Worksheets("Tabell").Range("H" + CStr(ordning(G, 2) + hopp2(c))).Formula + "Matcher!F" + CStr(Offset + hopp(c)) + "+"
                
                hopp(c) = hopp(c) + antalGrupper
                
                If c = antalGrupper Then
                    slutspelStart = hopp(c)
                End If
                
            Next
            
            
       
            'temp1 = "=" + Mid(Worksheets("Tabell").Range("G5").Formula, 1, Len(Worksheets("Tabell").Range("G5").Formula) - 1)
 
            'Worksheets("Tabell").Range("G5").Value = "=" + Mid(Worksheets("Tabell").Range("G5").Formula, 1, Len(Worksheets("Tabell").Range("G5").Formula) - 1)
             'MsgBox temp1
            
            ' Worksheets("Tabell").Range("G" + CStr(ordning(G, 1) + hopp2(c))).Formula = temp1 + " "
            ' Worksheets("Tabell").Range("G" + CStr(ordning(G, 2) + hopp2(c))).Formula = " " + temp2
            
            
            '=OM(Matcher!G4="";"";OM(Matcher!E4Matcher!F4;2;1)))
            '=OM(Matcher!G4="";"";OM(Matcher!E4Matcher!F4;0;1)))
            
            '=OM(Matcher!G4="";"";OM(#Referens!E4<#Referens!F4;0;OM(#Referens!E4>#Referens!F4;2;1)))
            '=OM(#REFERENS!G4="";"";OM(#REFERENS!E4<#REFERENS!F4;2;OM(#REFERENS!E4>#REFERENS!F4;0;1)))
           
       
            
        Next
       For x = 1 To antalGrupper
            For e = 1 To 4
                    Worksheets("Tabell").Range("G" + CStr(hopp2(x) + e)).Value = "=" + Mid(Worksheets("Tabell").Range("G" + CStr(hopp2(x) + e)).Formula, 1, Len(Worksheets("Tabell").Range("G" + CStr(hopp2(x) + e)).Formula) - 1)
                    Worksheets("Tabell").Range("H" + CStr(hopp2(x) + e)).Value = "=" + Mid(Worksheets("Tabell").Range("H" + CStr(hopp2(x) + e)).Formula, 1, Len(Worksheets("Tabell").Range("H" + CStr(hopp2(x) + e)).Formula) - 1)
            Next
            
        Next
        
        
       'Slutspel
        'om 1 grupp final med 1an och 2an i grupp A
        'om 1-2 grupper ingen semi
        'om 3-4 grupper semi
        'om 5+ grupper kvart
        
        '"M14:S31"
        'MsgBox CStr(slutspelStart)
        
        
        
        'Worksheets("matcher").Range("B" + CStr(slutspelStart + 3)).Select
        
            If antalGrupper = 1 Then
              
            End If
            
            If antalGrupper = 2 Then
                Worksheets("TemplatesTabell").Range("M14:S31").Copy
                Sheets("Matcher").Select
                Range("B" + CStr(slutspelStart + 3)).Select
                ActiveSheet.Paste
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(1) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(1) + 2)
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(2) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(2) + 2)
            End If
            
            If antalGrupper = 3 Then
                Worksheets("TemplatesTabell").Range("M14:S31").Copy
                Sheets("Matcher").Select
                Range("B" + CStr(slutspelStart + 3)).Select
                ActiveSheet.Paste
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(1) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(2) + 1)
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(3) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(3) + 2)
                
            End If
            
            If antalGrupper = 4 Then
                Worksheets("TemplatesTabell").Range("M14:S31").Copy
                Sheets("Matcher").Select
                Range("B" + CStr(slutspelStart + 3)).Select
                ActiveSheet.Paste
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(1) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 5)).Formula = "=Tabell!B" + CStr(hopp2(2) + 1)
               Worksheets("Matcher").Range("C" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(3) + 1)
               Worksheets("Matcher").Range("E" + CStr(slutspelStart + 6)).Formula = "=Tabell!B" + CStr(hopp2(4) + 1)
            End If
     
        
        
       Range("F3").Select
        
        'Application.ScreenUpdating = False
    
        
 
End Sub
 
Sub länka()
'
' länka Makro
' Makrot inspelat 2011-02-23 av mkbb
'
 
'
    ActiveCell.FormulaR1C1 = "=Deltagare!R[-2]C[1]"
    Range("B5").Select
    
        If A > 4 And A <= 8 Then
            Range("A" + antal).Select
            nr = A - 4
            ActiveCell.FormulaR1C1 = "MB" + nr
        End If
        
        If A > 8 And A <= 12 Then
            Range("A" + antal).Select
            nr = A - 8
            ActiveCell.FormulaR1C1 = "MC" + nr
        End If
        
        If A > 12 Then
            Range("A" + antal).Select
            nr = A - 12
            ActiveCell.FormulaR1C1 = "MD" + nr
        End If
        
End Sub
Sub clear()
'
' clear Makro
' Makrot inspelat 2011-02-23 av mkbb
'
 
'
    Cells.Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = xlNone
    Range("A1").Select
End Sub
Nytt inlägg
 2020-03-31 07:48
 
Christian

Medlem sedan: 2015-08-26
1209 inlägg
Hej Minna

Jag får inte fel på makrot du skickade. Har du kommenterat bort något så felet inte längre triggas? Om det är antaldeltagare = 48 som du tidigare försökte köra så är din matris turordning begränsad till 40 platser. Denna behöver utökas för att 48 deltagare ska få plats.

I övrigt så hade jag nog inte försökt mig på att utöka makrot med fler deltagare. Framförallt p.g.a hur sub matcher ser ut. Den är kodad på ett sätt som ä'r väldigt svårt att följa/förändra. I mina ögon ser den inte speciellt dynamisk ut och du skulle behöva lägga väldigt lång tid på att fixa till den.

Mvh
Christian
Nytt inlägg
 2020-04-01 11:04
 
Minna

Medlem sedan: 2020-03-24
3 inlägg

 Okej. Tack så mycket för hjälpen!!

Jag får kika vidare på om det finns något annat alternativ. Trodde att gruppspel skulle vara lätt att hitta en maill/tutorial på men jag har inte hittat en enda!
Nytt inlägg
 2020-04-02 08:36
 
Christian

Medlem sedan: 2015-08-26
1209 inlägg
Gör det, vi finns här om du behöver hjälp med något annat :). Det går självklart även att ta fram en totallösning åt dig, detta skulle dock vara på konsultbasis.

MVh
Christian
 Sida 1 av 1
Föregående Föregående
 
Nästa Nästa
ForumForumDiskussionerDiskussionerVBAVBAGruppspel, turordningGruppspel, turordning

PNG32 PNG32
Excelforum drivs av Excelspecialisten som bedriver utbildning i Excel och VBA, tillhandahåller support och hjälp med Excel, utvecklar program i Excel. Är ni i behov av en konsult inom Excel, VBA eller VSTO, eller söker en excelkurs, kontakta oss.
Copyright 2013 ExcelSpecialisten XLS AB   Användarvillkor  Personliga uppgifter