erreur d'éxécution'6'

[jad73]

bonjour le forum
j'ai un message "erreur d'execution'6' depassement de capacité" dans mon code vba
que je joints
c'est la ligne "DeltaV = Application.WorksheetFunction.Max(rg)" qui est surligné en jaune,comme je ne connais pas grand chose au code vba ou se trouve l'erreur.

Sub jad()
Dim wsData As Worksheet, wsR1 As Worksheet, wsR2 As Worksheet, wsR3 As Worksheet, wsR4 As Worksheet, wsR5 As Worksheet, wsR6 As Worksheet, rg As Range
Dim larg As Integer, Série1 As Variant, Série2 As Variant
Dim i%, j%, k%, nLg%, jmax%, DeltaV%, Départ%, rCol%
Dim rmax%, rLig() As Integer
'----------- Lignes à modifier selon convenance --------------
Départ = 2 'N° de la première ligne des résultats
Set wsData = Worksheets("keno") ' feuille contenant les données
Set wsR1 = Worksheets("k1")
Set wsR2 = Worksheets("k2") ' feuille contenant les réultats
Set wsR3 = Worksheets("k3")
Set wsR4 = Worksheets("k4")
Set wsR5 = Worksheets("k5")
Set wsR6 = Worksheets("k6") ' feuille contenant les réultats

wsData.Range("C1") = "Données" ' impose un titre à la base de données
'------------------------------------------------------------

i = 2 'N° de la première ligne des données
Application.ScreenUpdating = False
With wsData
Set rg = .Range("C2").CurrentRegion
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
larg = rg.Columns.Count 'nbre de données sur une ligne
DeltaV = Application.WorksheetFunction.Max(rg)
ReDim rLig(DeltaV)
' inscription du N° des blocs de résultats
For j = 1 To DeltaV: rLig(j) = Départ - 1
If j < Int(255 / (larg + 1) + 1) Then
wsR1.Cells(rLig(j), (larg + 1) * (j - 1) + 1) = j: jmax = j
Else
k = k + 1: wsR2.Cells(rLig(j), (larg + 1) * (k - 1) + 1) = j
End If
Next j
Série1 = .Range(.Cells(i, 1), .Cells(i, larg)).Value
rmax = (jmax - 1) * (larg + 1) + 1
'For j = 1 To DeltaV: rLig(j) = Départ - 1: wsR.Cells(rLig(j), (larg + 1) * (j - 1) + 1) = j: Next j
'Série1 = .Range(.Cells(i, 1), .Cells(i, larg)).Value

' répartition des données dans les blocs
While i <= rg.Rows.Count
i = i + 1
Série2 = .Range(.Cells(i, 1), .Cells(i, larg)).Value
For j = LBound(Série1, 2) To UBound(Série1, 2)
rLig(Série1(1, j)) = rLig(Série1(1, j)) + 1
nLg = rLig(Série1(1, j))
rCol = (Série1(1, j) - 1) * (larg + 1) + 1
If rCol <= 0 Then MsgBox "Pas de valeur nulle dans les données. Veuillez corrigez.": Exit Sub
If rCol <= rmax Then
wsR1.Range(wsR1.Cells(nLg, rCol), wsR1.Cells(nLg, rCol + larg - 1)) = Série2
Else
k = rCol - rmax - larg: wsR2.Range(wsR2.Cells(nLg, k), wsR2.Cells(nLg, k + larg - 1)) = Série2
End If
Next j
Série1 = Série2
Wend
End With
Application.ScreenUpdating = True

End Sub
merci

 

[JNP]

Re : erreur d'éxécution'6'

Bonsoir Jad73 🙂,
Avec 213 messages au compteur depuis 2008, tu dois quand même savoir où se trouve la balise

#

pour entourer ton code 😡...
Et fréquentant le forum depuis ce temps, tu devrais savoir que l'erraur située sur un Max de formule de feuille ne pourra pas nous permettre de te donner une idée, vu qu'on n'a pas le fichier pour savoir ce que rg vaut à part

rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)

Ne t'attend pas à une réponse sans la matière pour pouvoir travailler 😱 !...
Bonne soirée 😎

 

[julberto]

Re : erreur d'éxécution'6'

Bonsoir à tous, bonsoir Jad73,

Ce fil est la continuité de celui-ci

Origine du problème : Une erreur de frappe s'est glissée dans les données entrées par Jad sur la feuille "kéno", la variable range "rg" ne peut véritablement contenir que des valeurs qui ne dépassent pas quelques petites dizaines d'unités. DeltaV ne peut être qu'un entier sur 16 bits.
Jad vérifie tes données consciencieusement.

A +

 

[JNP]

Re : erreur d'éxécution'6'

Re 🙂,

suite à lecture du marc de café (de ce matin, donc résultat moins bon)

DeltaV&

🙄

Bonne idée, je vais peut-être passer de la boule de cristal aux marc de café (à moins que le tarot soit encore plus efficace ?) 😛...

Ce fil est la continuité de celui-ci

Merci de l'info Julberto 😉.
Mais pourquoi n'est-il pas resté sur le même fil 😕 ? Lecteur du forum depuis 2008, il devrait le savoir 🙄...
Bon WE 😎

 

[jad73]

Re : erreur d'éxécution'6'

bonjour julberto,le forum
je viens de vérifier le fichier le premier DeltaV,est ecrit DeltV%(c'est bien le signe pourcentage) et les autres DeltaV sont écrit DeltaV,de toute façon j'ai fais par copier/coller
merci julberto de ta patience

ps(pour JNP)Gabin dans une chanson disait "tout ce que je sais c'est que je ne sais rien",c'est mon cas.

 

[julberto]

Re : erreur d'éxécution'6'

Bonjour Jad73,

Si tu veux régler ton problème, veux-tu bien te conformer à ce que j'ai dit dans le fil N°4 !!

Pour rappel :

Origine du problème : Une erreur de frappe s'est glissée dans les données entrées par Jad sur la feuille "kéno", la variable range "rg" ne peut véritablement contenir que des valeurs qui ne dépassent pas quelques petites dizaines d'unités. DeltaV ne peut être qu'un entier sur 16 bits.

Jad vérifie tes données consciencieusement.

cordialement

 

[jad73]

Re : erreur d'éxécution'6'

bonjour julberto,le forum

je ne sais si je te l'ai dit mais je ne connais rien au code vba.
j'ai vérifié avec ton fichier du 13/05 l'original, et je n'ai pas trouvé ou se trouve l'erreur de frappe.
merci

 

[JNP]

Re : erreur d'éxécution'6'

Re 🙂,
Remplace

DeltV%

par

DeltV As Long

en début de macro 🙄...
Bonne soirée 😎

 

[julberto]

Re : erreur d'éxécution'6'

Bonjour le fil, bonjour Jad73,

Ma réponse du 16/05/2011 00h03 tient toujours. Jad, relis bien ce que je disais.

Origine du problème : Une erreur de frappe s'est glissée dans tes données entrées sur la feuille "kéno", la variable range "rg" ne peut véritablement contenir que des valeurs qui ne dépassent pas quelques petites dizaines d'unités. DeltaV ne peut être qu'un entier sur 16 bits.

J' ai parcouru internet pour connaitre les modalités du Keno. Les données à entrer doivent toutes être inférieures ou égales à 70. Donc DeltaV reste avec son "%". S'il ne va pas ainsi c'est qu'une donnée n'est pas conforme aux règles du Keno.
Ci-joint une version de la macro qui étend maintenant l'éclatement des résultats sur 3 feuilles.

 

[jad73]

Re : erreur d'éxécution'6'

bonjour julberto,carcharodon-carcharias,le forum

je vais essayer de m'expliquer clairement et je m'excuse pour ma mauvaise organisation,je joint le fichier tel qu'il est dans mon classeur,
j'ai recopié ton code julberto et rajouter des feuilles mais toujours depassement de capacité.
quand a l'erreur de frappe je ne vois pas ou elle se trouve le fichier des données vient directement de la fdj que j'ai téléchargé sur son site.
de plus carcharodon dit "deltav as byte" je ne sais plus trés bien qui suivre,autre chose je suis en excel2003 et vous excel2007,y aurait-il probleme?
merci

 

[julberto]

Re : erreur d'éxécution'6'

Re,

jad73,
je joint le fichier tel qu'il est dans mon classeur,

C'était la meilleure résolution à prendre.
Tes propres modifs ne pouvaient pas fonctionner.

Je te renvoie ton classeur modifié et fonctionnel sur la base des données fournies.
Tu peux augmenter le nombre de lignes à ta guise.
Si tu augmentes le nombre de colonnes, il te faudra ajouter d'autres feuilles et modifier la macro en conséquence.

cordialement

 

[jad73]

Re : erreur d'éxécution'6'

bonjour julberto,le forum
j'ai donc recopié ton code dans mon classeur et mis le nombre de feuilles qu'il me fallait mais j'ai le message"trop de feuilles résultats éxigées"pourtant il me faut bien 6 feuilles pour inscrire les résultats plus la feuille de données.ou se trouve le probleme
merci

Sub Jad73()

Dim wsData As Worksheet, wsR1 As Worksheet, wsR2 As Worksheet
Dim wsR3 As Worksheet, wsR4 As Worksheet, wsR5 As Worksheet
Dim wsR6 As Worksheet, rg As Range, larg%
Dim Série1 As Variant, Série2 As Variant
Dim i%, j%, k%, m%, n%, o%, p%, nLg%, jmax%, Départ%
Dim rmax%, rCol%, DeltaV%, rLig() As Integer

'----------- Lignes à modifier selon convenance --------------
Départ = 2                 'N° de la première ligne des résultats
Set wsData = Worksheets("keno")   ' feuille contenant les données
Set wsR1 = Worksheets("1a12")      ' feuille contenant les réultats
Set wsR2 = Worksheets("13a24")      ' feuille suite contenant les réultats
Set wsR3 = Worksheets("25a36")
Set wsR4 = Worksheets("37a48")
Set wsR5 = Worksheets("49a60")
Set wsR6 = Worksheets("61a70")
wsData.Range("A1") = "Données"      ' impose un titre à la base de données
'------------------------------------------------------------

i = 2                             'N° de la première ligne des données
Application.ScreenUpdating = False
With wsData
  .Range("C2").Select
  Set rg = .Range("C2").CurrentRegion
  Set rg = rg.Offset(1, 2).Resize(rg.Rows.Count - 1, rg.Columns.Count - 2)
  larg = rg.Columns.Count                          'nbre de données sur une ligne
  DeltaV = Application.WorksheetFunction.Max(rg)
  ReDim rLig(DeltaV)
                 
  jmax = Int(Application.Columns.Count / (larg + 1))
                        ' inscription du N° des blocs de résultats
  For j = 1 To DeltaV: rLig(j) = Départ - 1
    If j <= jmax Then
      wsR1.Cells(rLig(j), (larg + 1) * (j - 1) + 1) = j
    ElseIf j <= 2 * jmax Then
      k = k + 1: wsR2.Cells(rLig(j), (larg + 1) * (k - 1) + 1) = j
    ElseIf j <= 3 * jmax Then
      m = m + 1: wsR3.Cells(rLig(j), (larg + 1) * (m - 1) + 1) = j
    ElseIf j <= 4 * jmax Then
      n = n + 1: wsR4.Cells(rLig(j), (larg + 1) * (n - 1) + 1) = j
    ElseIf j <= 5 * jmax Then
      o = o + 1: wsR5.Cells(rLig(j), (larg + 1) * (o - 1) + 1) = j
    ElseIf j <= 6 * jmax Then
      p = p + 1: wsR6.Cells(rLig(j), (larg + 1) * (p - 1) + 1) = j
    Else
      MsgBox "Trop de feuilles résultats exigées. Modifier la macro ou modifier les données."
      End
    End If
  Next j
  Série1 = .Range(.Cells(i, 3), .Cells(i, larg + 2)).Value
  rmax = jmax * (larg + 1)
                 ' répartition des données dans les blocs
  While i <= rg.Rows.Count
    i = i + 1
    Série2 = .Range(.Cells(i, 3), .Cells(i, larg + 2)).Value
    For j = LBound(Série1, 2) To UBound(Série1, 2)
      rLig(Série1(1, j)) = rLig(Série1(1, j)) + 1
      nLg = rLig(Série1(1, j))
      rCol = (Série1(1, j) - 1) * (larg + 1) + 1
      If rCol <= 0 Then MsgBox "Pas de valeur nulle dans les données. Veuillez corrigez.": Exit Sub
      If rCol < rmax Then
        wsR1.Range(wsR1.Cells(nLg, rCol), wsR1.Cells(nLg, rCol + larg - 1)) = Série2
      ElseIf rCol < 2 * rmax Then
        k = rCol - rmax: wsR2.Range(wsR2.Cells(nLg, k), wsR2.Cells(nLg, k + larg - 1)) = Série2
      ElseIf rCol < 3 * rmax Then
        k = rCol - 2 * rmax: wsR3.Range(wsR3.Cells(nLg, k), wsR3.Cells(nLg, k + larg - 1)) = Série2
      ElseIf rCol < 4 * rmax Then
        k = rCol - 3 * rmax: wsR4.Range(wsR4.Cells(nLg, k), wsR4.Cells(nLg, k + larg - 1)) = Série2
      ElseIf rCol < 5 * rmax Then
        k = rCol - 4 * rmax: wsR5.Range(wsR5.Cells(nLg, k), wsR5.Cells(nLg, k + larg - 1)) = Série2
      Else
        k = rCol - 5 * rmax: wsR6.Range(wsR6.Cells(nLg, k), wsR6.Cells(nLg, k + larg - 1)) = Série2
      End If
    Next j
    Série1 = Série2
  Wend
End With
Application.ScreenUpdating = True

End Sub

 

[jad73]

Re : erreur d'éxécution'6'

bonjour julberto,le forum

je viens de voir que dans mes feuilles de résultats les n° des blocs sont beaucoup plus espacés que dans ton fichier.
chez toi le 1 est en col A,le 2 en col V le 3 en col AQ.
chez moi le 1 en col A,le 2 en col AQ le 3 en col CG.
cela ne viendrait-il pas de la version d'excel,moi 2003 toi 2007.
salutations

 

[jad73]

Re : erreur d'éxécution'6'

bonjour le forum

je fais remonter mon dernier post si quelqu'un peut m'aider.
merci

 

[julberto]

Re : erreur d'éxécution'6'

Bonsoir Jad73,

Jad73,
chez toi le 1 est en col A,le 2 en col V le 3 en col AQ.
chez moi le 1 en col A,le 2 en col AQ le 3 en col CG.
cela ne viendrait-il pas de la version d'excel,moi 2003 toi 2007.

- 2003 ou 2007 ?--> NON

- chez toi le 1 est en col A,le 2 en col V le 3 en col AQ

--> 2 en col V car ta base de données était sensée comporter 20 colonnes comme suggéré par ton dernier appel au secours. Ma réponse avait été cette fois là "tu peux augmenter le nombre de lignes mais pas le nombre de colonnes !!

Depuis le début de tes demandes le nombre de colonnes ne cesse d'augmenter -> on ne s'en sortira jamais tel que c'est parti. 5 colonnes la première fois, puis dix puis 20 et maintenant 42......

En plus, il n'a jamais été envisagé que des colonnes de dates soient insérées parmi les numéros de tirage. Ce qui n'arrange rien quand on sait pas où ces colonnes sont placées.

En conclusion l'organisation actuelle de tes résultats est aberrante et il s'agirait maintenant de prévoir une autre organisation plus rationnelle.
Je ne peux rien te proposer car je ne sais toujours pas quel est le but de tout cela et comment croît ta base de données.

Je me suis toujours depuis le début conformé à ton "cahier des charges" et cela a toujours été un échec. Donc ou je suis débile ou tu ne te conformes pas à ton propre "cahier des charges" ou de façon plus réaliste "tu n'as pas de cahier des charges.

cordialement malgré tout.