Bonjour,
j'ai un problème avec cette macro
les nombre du derniere tirage depasse le max de 90
il sagit d' un tirage pour le bingo ( 12 carte ) la derniere n'est pas corecte?
voir g41 en fin de programme
Sub Bingo()
Dim Dic As Object, Arr(), X As Integer
Dim A As Integer, B As Integer, Nb As Integer
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("A2")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("A2").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("A2").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("A10")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a10").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a10").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a18")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a18").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a18").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a25")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a25").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a25").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a33")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a33").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a33").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a41")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a41").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a41").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g2")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g2").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g2").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g10")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g10").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g10").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g18")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g18").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g18").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g25")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g25").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g25").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g33")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g33").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g33").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g41")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g41").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g41").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Blad1").Select
Range("n1").Select
Selection.Copy
Sheets("Blad1").Select
Range("c1").Select
Selection.PasteSpecial Paste:=xlPasteValues, skipBlanks:=False
End Sub
Sub Afrukken()
'
' Afrukken Macro
'
'
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub
tu as une icone pour mettre en forme le code. Là ce n'est pas digeste...
Le mieux est de déposer le fichier sur cjoint.com et de coller ici le lien ici.
voir fichier le problème ce situe dans les celulles (g41:k46) les monbre sont superieur a 90 ce qui n'est pas le cas dans toutes les autre cartes
https://www.cjoint.com/?DIqi3ri64Fl