Problemme macro

Résolu
Dandy_danbe Messages postés 109 Date d'inscription   Statut Membre Dernière intervention   -  
Dandy_danbe Messages postés 109 Date d'inscription   Statut Membre Dernière intervention   -
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

3 réponses

  1.
    eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    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
  2. Dandy_danbe Messages postés 109 Date d'inscription   Statut Membre Dernière intervention  
     
    je ne peut metre de lien car contien une macro
    0
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      ???
      0
  3. Dandy_danbe Messages postés 109 Date d'inscription   Statut Membre Dernière intervention  
     
    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
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Bonjour,

      il faut coller le lien fourni ici.
      eric
      0
    3. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      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
    4. Dandy_danbe Messages postés 109 Date d'inscription   Statut Membre Dernière intervention  
       
      merci j'avais pas vus cette faute
      0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

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

7 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses