Boucles et décalage

alpilon · 21 Juin 2010

Bonjour,

Pouvez-vous me donner un coup de main

j'ai une plage que je copie sur une ligne

Code:

Sub Copy_Bilan()

Dim Derlig1 As Long



    Set Wbk1 = ThisWorkbook
    
    Derlig1 = Wbk1.Worksheets("ULTIMATE").Cells.Find("*", , , , , xlPrevious).Row
    
  
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 2).Value = Wbk1.Worksheets("ULTIMATE").Range("C3").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 3).Value = Wbk1.Worksheets("ULTIMATE").Range("C4").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 4).Value = Wbk1.Worksheets("ULTIMATE").Range("C5").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 5).Value = Wbk1.Worksheets("ULTIMATE").Range("E2").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 6).Value = Wbk1.Worksheets("ULTIMATE").Range("E3").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 7).Value = Wbk1.Worksheets("ULTIMATE").Range("E4").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 8).Value = Wbk1.Worksheets("ULTIMATE").Range("E5").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 9).Value = Wbk1.Worksheets("ULTIMATE").Range("E6").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 10).Value = Wbk1.Worksheets("ULTIMATE").Range("E7").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 11).Value = Wbk1.Worksheets("ULTIMATE").Range("E8").Value
        
 MsgBox "Transfert Terminé "
End Sub

en suite j'efface la plage à retranscrire

Code:

Sub Clear()

Sheets("ULTIMATE").Range("B2:B8").ClearContents


End Sub

et je peux recommencer l'opération

maintenant ce que j'aimerais faire au prochain enregistrement,

c'est décaler de trois celulles vers la droite mais en conservant le même canevas

pour comprendre, au second enregistrement le code initial devrait se transformer comme ceci (voir les positions de colonnes)

Code:

Sub Copy_Bilan()

Dim Derlig1 As Long



    Set Wbk1 = ThisWorkbook
    
    Derlig1 = Wbk1.Worksheets("ULTIMATE").Cells.Find("*", , , , , xlPrevious).Row
    
  
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 5).Value = Wbk1.Worksheets("ULTIMATE").Range("C3").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 6).Value = Wbk1.Worksheets("ULTIMATE").Range("C4").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 7).Value = Wbk1.Worksheets("ULTIMATE").Range("C5").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 8).Value = Wbk1.Worksheets("ULTIMATE").Range("E2").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 9).Value = Wbk1.Worksheets("ULTIMATE").Range("E3").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 10).Value = Wbk1.Worksheets("ULTIMATE").Range("E4").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 11).Value = Wbk1.Worksheets("ULTIMATE").Range("E5").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 2).Value = Wbk1.Worksheets("ULTIMATE").Range("E6").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 3).Value = Wbk1.Worksheets("ULTIMATE").Range("E7").Value
        Wbk1.Worksheets("ULTIMATE").Cells(Derlig1 + 1, 4).Value = Wbk1.Worksheets("ULTIMATE").Range("E8").Value
        
 MsgBox "Transfert Terminé "
End Sub

Comment puis-je construire une boucle avec ce décalage de cellules sans sortir des dix colonnes ?

au final si je prends les mêmes nombres lors de chaque enregistrement je devrais obtenir cela :

1 2 3 4 5 6 7 8 9 10
4 5 6 7 8 9 10 1 2 3
7 8 9 10 1 2 3 4 5 6
10 1 2 3 4 5 6 7 8 9
3 4 5 6 7 8 9 10 1 2
6 7 8 9 10 1 2 3 4 5
9 10 1 2 3 4 5 6 7 8
2 3 4 5 6 7 8 9 10 1
5 6 7 8 9 1 10 1 2 3
8 9 10 1 2 3 4 5 6 7
1 2 3 4 5 6 7 8 9 10 ...etc...

MERCI de votre aide 🙂

tototiti2008 · 21 Juin 2010

Re : Boucles et décalage

Bonjour alpilon,

à tester dans une feuille vide

Code:

Sub a()
Dim i As Long, j As Long
For i = 1 To 100
    For j = 1 To 10
        Cells(i, 1) = i
        Cells(i, j + 1) = ((j - 1 + (i - 1) * 3) Mod 10) + 1
    Next j
Next i
End Sub

alpilon · 21 Juin 2010

Re : Boucles et décalage

Merci tototiti2008

c'est cela sauf que je ne devrais avoir qu'une seule ligne à la fois à chaque Macro que je lance et non 100 lignes 😱 🙂🙂

merci pour ton aide

pierrejean · 21 Juin 2010

Re : Boucles et décalage

bonjour alpilon

A tester

Code:

Sub Copy_Bilan()
Dim Derlig1 As Long
    Set Wbk1 = ThisWorkbook
    Derlig1 = Wbk1.Worksheets("ULTIMATE").Cells.Find("*", , , , , xlPrevious).Row
    cellules = Array("C3", "C4", "C5", "E2", "E3", "E4", "E5", "E6", "E7", "E8")
 Index = 0
 ligne = Derlig1
 For n = 1 To 15 [COLOR=seagreen]'15= valeur a adapter
[/COLOR]     For m = 2 To 11
        Wbk1.Worksheets("ULTIMATE").Cells(ligne + 1, m).Value = Wbk1.Worksheets("ULTIMATE").Range(cellules(Index)).Value
        Index = Index + 1
        If Index > 9 Then Index = Index - 10
     Next m
     Index = Index + 3
     If Index > 9 Then Index = Index - 10
     ligne = ligne + 1
 Next n
 MsgBox "Transfert Terminé "
End Sub

pierrejean · 21 Juin 2010

Re : Boucles et décalage

Re

Version ligne par ligne

Par contre je'ais pas testé ce qu'il se passe lorsque le fichier est clos puis ouvert a nouveau
Teste et dis-nous

Edit: Salut Tototiti (et mes excuses pour ne pas l'avoir fait plus tot)

alpilon · 21 Juin 2010

Re : Boucles et décalage

Merci Pierre Jean, on y est presque

mais peut-être me suis-je mal exprimé
tu me donne le choix d'une valeur à adapter, mais elle est de 1 puisque je souhaite que ce décalage intervienne après chaque enregistrement ou macro.

je vais essayé d'être plus clair :

ma plage à copier est ("C3", "C4", "C5", "E2", "E3", "E4", "E5", "E6", "E7", "E8")
elle contient les nombres qui vont varier après chaque enregistrement
avant le 1er enregistrement admettons ceci : 1 2 3 4 5 6 7 8 9 10

je lance la macro et j'ai

1 2 3 4 5 6 7 8 9 10 et c'est tout ce que je dois avoir.

puis les chiffres de ma plage changent soit par exemple
30 31 32 33 34 35 36 37 38 39

Je lance de nouveau la macro, le fichier doit ressembler à ceci :

1 2 3 4 5 6 7 8 9 10

33 34 35 36 37 38 39 30 31 32

et ainsi de suite...

En fait c'est une boucle qui contient des macros plutôt qu'une macro qui contient des boucles 🙂

Merci à vous 🙂

alpilon · 22 Juin 2010

Re : Boucles et décalage

Pierre Jean, nos réponses ont du se croiser !

j'ai tester le fichier zip

cela fonctionne parfaitement tant qu'il est ouvert, mais une fois fermé et réouvert cela ne fonctionne plus, il me remet la première ligne...

y-a-t'il un moyen pour qu'Excel conserve la derniere variable en mémoire ?
Comment l' enregistrer et la recharger à l'ouverture ?

Merci 🙂

ROGER2327 · 22 Juin 2010

Re : Boucles et décalage

Bonsoir à tous

Un essai dans le classeur joint.

ROGER2327
#3738

Samedi 7 Gidouille 137 (Saint Bébé Toutout, évangéliste, SQ)
3 Messidor An CCXVIII
2010-W25-1T23:39:16Z

alpilon · 22 Juin 2010

Re : Boucles et décalage

Bravo ROGER2327

Cela fonctionne parfaitement, je vous remercie tous car je reconnais que je n'ai pas trop forcé sur le sujet, mais, je suis plus fonctions que VBA 🙂

je ne manquerais pas de donner crédit aux auteurs lorsque le fichier sera transmis à mes amis du forum Newturf.

merci encore et bonne journée à tous

Alpilon 🙂

ROGER2327 · 22 Juin 2010

Re : Boucles et décalage

Re...

Tant mieux si le code vous convient. En voici une version plus paramétrée susceptible de faciliter l'adaptation et la maintenance.

Code:

[COLOR="DarkSlateGray"][B]Sub Copy_Bilan()
Dim Derlig1&, col1&, i&, n&, cmpte&, dcl&, aDat
   col1 = 2 [COLOR="Sienna"]'première colonne d'affichage[/COLOR]
   dcl = 3 [COLOR="Sienna"]'valeur du décalage[/COLOR]
   cmpte = SERVICE2327.[A1].Value
   With ThisWorkbook.Worksheets("ULTIMATE")
      Derlig1 = .Cells.Find("*", , , , , xlPrevious).Row + 1 [COLOR="Sienna"]'ligne d'écriture[/COLOR]
      aDat = Array(.[C3], .[C4], .[C5], .[E2], .[E3], .[E4], .[E5], .[E6], .[E7], .[E8]) [COLOR="Sienna"]'tableau de données[/COLOR]
      n = UBound(aDat) + 1
      For i = 0 To n - 1
         .Cells(Derlig1, col1 + (i + cmpte) Mod n).Value = aDat(i).Value
      Next i
   End With
   SERVICE2327.[A1].Value = (SERVICE2327.[A1].Value + n - dcl) Mod n
   MsgBox "Transfert Terminé"
End Sub[/B][/COLOR]

ROGER2327
#3739

Dimanche 8 Gidouille 137 (Sainte Boudouille, bayadère, ST)
4 Messidor An CCXVIII
2010-W25-2T11:00:14Z

Effectuez une recherche sur Excel Downloads...

Boucles et décalage

alpilon

XLDnaute Junior

tototiti2008

XLDnaute Barbatruc

alpilon

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

alpilon

XLDnaute Junior

alpilon

XLDnaute Junior

ROGER2327

XLDnaute Barbatruc

Pièces jointes

alpilon

XLDnaute Junior

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée