Sujet Précédent Sujet Suivant

Problemme macro

Résolu/Fermé
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022 - 15 sept. 2014 à 06:15
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022 - 16 sept. 2014 à 09:35
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



A voir également:

3 réponses

Réponse 1 / 3
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 7 239
15 sept. 2014 à 08:49
Bonjour,

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.

eric
0
Réponse 2 / 3
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022
15 sept. 2014 à 11:19
je ne peut metre de lien car contien une macro
0
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 7 239
15 sept. 2014 à 15:37
???
0
Réponse 3 / 3
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022
Modifié par Dandy_danbe le 16/09/2014 à 08:56
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
0
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 7 239
16 sept. 2014 à 08:57
Bonjour,

il faut coller le lien fourni ici.
eric
0
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022
16 sept. 2014 à 09:02
https://www.cjoint.com/?DIqi3ri64Fl
0
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 7 239
16 sept. 2014 à 09:19
Nb = Application.RandBetween(A, B)
avec A=91 et B=108 ne peut pas donner autre chose.
C'est g et h qu'il faut utiliser.

eric
0
Dandy_danbe Messages postés 108 Date d'inscription mardi 18 mars 2014 Statut Membre Dernière intervention 11 avril 2022
16 sept. 2014 à 09:35
merci j'avais pas vus cette faute
0

Discussions similaires

faire une boucle sans VBA
lucky-luccio -
lucky-luccio -

3 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
Copie automatique tableau Excel sans macro
sodwac -
sodwac -

5 réponses
tri automatque sur excel sans créer de macro
hugofauch -
hugofauch -

2 réponses