Poursuivre sur une autre feuille

[cibleo]

Bonsoir le forum,

Cette macro recopie une suite de n nombres fact(n)/n fois
Sous Excel 2003, tout se passe bien pour 8 éléments soit 40320 cellules remplies ; la suite est recopiée 5040 fois.
Si je dépasse 8 éléments, comment puis-je poursuivre sur les feuilles suivantes lorsque que je dépasse 65536 lignes (et éventuellement recréer des nouvelles feuilles) ?

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
With Feuil1
  For i = 1 To x Step y
  .Range("a" & i).Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
Next i
End With
End Sub

Cibleo

 

[mapomme]

Re : Poursuivre sur une autre feuille

Bonjour cibleo,

Un essai dans le fichier joint.

Sub recopier_factorielle2()
Dim Tbl(), i As Long, y As Byte, x As Long
Dim Tablo, N As Long, wsk As Worksheet, j As Long, K As Long

Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)

'Effacement des feuilles
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
  Sheets(i).Delete
Next i
Application.DisplayAlerts = True
Range("a:a").Clear

Application.ScreenUpdating = False
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
Set wsk = Sheets("Feuil1")
i = 1

Do
  If i + y - 1 > Rows.Count Then
    K = 0
    Do
      If i > Rows.Count Then
        Sheets.Add after:=wsk
        Set wsk = ActiveSheet
        i = 1
      End If
      K = K + 1
      wsk.Cells(i, 1) = K
      i = i + 1
    Loop Until K = y
    Application.ScreenUpdating = True
    DoEvents
    Application.ScreenUpdating = False
  Else
    wsk.Range("a" & i).Resize(y, 1).Value = Application.Transpose(Tbl)
    i = i + y
  End If
  N = N + y
Loop Until N >= x
  
Application.ScreenUpdating = True
MsgBox "c'est fini !"
End Sub

 

[cibleo]

Re : Poursuivre sur une autre feuille

Bonjour à tous,
Bonjour mapomme

Impeccable, sinon si tu pouvais apporter un petit correctif pour prendre en compte la variable Tbl composée d'éléments string.

Tbl = Array("O","F", "M", "W", "Q", "U", "Z", "T", "D")

On voit apparaître en tête de chaque feuille une portion de la série des éléments chiffrés.

Merci pour tout Cibleo

 

[job75]

Re : Poursuivre sur une autre feuille

Bonjour cibleo, mapomme,

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long, n As Integer, lig As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
n = 1
lig = 1
On Error Resume Next
For i = 1 To x Step y
  Sheets(n).Range("a" & lig).Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
  lig = lig + y
  If Err Then Err = 0: i = i - 1: n = n + 1: lig = 1
Next
End Sub

Comme FACT(9) = 362880 il faut prévoir 6 feuilles sur Excel 2003.

A+

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

Bien entendu on peut créer les feuilles manquantes automatiquement :

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long, n As Integer, lig As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
n = 1
lig = 1
On Error Resume Next
For i = 1 To x Step y
  Sheets(n).Range("a" & lig).Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
  lig = lig + y
  If Err Then Err = 0: i = i - 1: n = n + 1: lig = 1: _
    If n > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
Next
End Sub

A+

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

Si l'on est flemmard, effacement préalable des feuilles :

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long, n As Integer, lig As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
n = 1
lig = 1
Sheets(1).[A:A].ClearContents 'RAZ
On Error Resume Next
For i = 1 To x Step y
  Sheets(n).Range("a" & lig).Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
  lig = lig + y
  If Err Then i = i - 1: n = n + 1: lig = 1: Sheets(n).[A:A].ClearContents: Err = 0: _
    If n > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
Next
End Sub

A+

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

Un plus avec la suppression des feuilles inutiles :

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long, n As Integer, lig As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
n = 1
lig = 1
Sheets(1).[A:A].ClearContents 'RAZ
On Error Resume Next
For i = 1 To x Step y
  Sheets(n).Range("a" & lig).Resize(UBound(Tbl) + 1) = Application.Transpose(Tbl)
  lig = lig + y
  If Err Then i = i - y: n = n + 1: lig = 1: Sheets(n).[A:A].ClearContents: Err = 0: _
    If n > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
Next
'---suppression des feuilles inutiles---
Application.DisplayAlerts = False
For n = Sheets.Count To n + 1 Step -1
  Sheets(n).Delete
Next
End Sub

Edit : comme indiqué par mapomme au post #10 j'ai remplacé i - 1 par i - y.

A+

 

[mapomme]

Re : Poursuivre sur une autre feuille

Bonjour cibleo, job75,

sinon si tu pouvais apporter un petit correctif pour prendre en compte la variable Tbl composée d'éléments string.
On voit apparaître en tête de chaque feuille une portion de la série des éléments chiffrés.

Il faut remplacer dans le code la ligne:

wsk.Cells(i, 1) = K

par:

wsk.Cells(i, 1) = Tbl(K - 1)

 

[cibleo]

Re : Poursuivre sur une autre feuille

Bonsoir mapomme, job75, le forum

C'est tout bon pour mapomme.
Job75 : dans tes codes des posts 5#, 6# et 7#, la recopie dans les 5 premières feuilles s'arrête aux lignes 65529 et non 65536.
Au final, il manque 36 cellules soit 4 recopies de 9 éléments.
(5 * 65529) + (1 * 35199) = 362 844 cellules et non 362 880 ---> fact(9)

Si tu pouvais rectifier le tir
Cibleo

Edit : c'est pas que cela m'ennuie que cela s'arrête aux lignes 65529 mais c'est la totalité des cellules remplies soit 362844 au lieu de 362880 (fact9)
Sinon j'ai pas testé avec 10 éléments soit presque 56 feuillles à générer. Mon vieux PC ne supporte pas "l'explosion combinatoire"

 

[mapomme]

Re : Poursuivre sur une autre feuille

Bonjour cibleo, job75,

Pour les codes de job75, essayez de remplacer i=i-1 par i=i-y

 

[job75]

Re : Poursuivre sur une autre feuille

Bonjour cibleo, mapomme,

Bonjour cibleo, job75,

Pour les codes de job75, essayez de remplacer i=i-1 par i=i-y

C'est tout à fait exact, merci, j'avais fait une erreur.

A+

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

@ cibleo

Il est normal que les 5 premières feuilles ne soient pas remplies jusqu'à la ligne 65536.

En effet pour chaque valeur de i/lig ce sont des séries entières de 9 chiffres qui sont créées.

Je ne vois pas pourquoi cela serait gênant.

Bonne nuit et A+

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

Pour en terminer, noter qu'on peut se passer de On Error Resume Next :

Sub recopier_factorielle()
Dim Tbl, i As Long, y As Byte, x As Long, n As Integer, lig As Long
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
y = UBound(Tbl) + 1
x = Application.WorksheetFunction.Fact(y)
n = 1
lig = 1
Sheets(1).[A:A].ClearContents 'RAZ
For i = 1 To x Step y
  Sheets(n).Range("a" & lig).Resize(y) = Application.Transpose(Tbl)
  lig = lig + y
  If lig + y - 1 > Rows.Count Then
    lig = 1: n = n + 1
    If n > Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(n).[A:A].ClearContents
  End If
Next
'---suppression des feuilles inutiles---
Application.DisplayAlerts = False
For n = Sheets.Count To n + 1 Step -1
  Sheets(n).Delete
Next
End Sub

A+

 

[cibleo]

Re : Poursuivre sur une autre feuille

Re à tous,

Oui job75, la recopie des séries n'est pas "tronquée", cela me convient également.
Merci à tous les 2.

Cibleo

 

[job75]

Re : Poursuivre sur une autre feuille

Re,

Voici deux macros un peu plus élaborées dans le fichier joint.

Sur Win 7 - Excel 2010 la 1ère s'exécute en 5,2 secondes, la 2ème en 1,2 seconde.

La 2ème utilise en effet un tableau de dimension maximum (65536 lignes).

A+