alignement gauche de blocs de cellules

[jeromear]

Bonjour à tous les passionnés d'Excel.
Sur une ligne, je cherchais à effectuer un alignement à gauche de 7 blocs composés de 4 cellules, pleines ou vides .

Regarde la pièce jointe DECALER CELLULES 1.xls

RiquetLan76 m'a proposé une macro qui fonctionne bien :


Sub CopyDecaler()
'
' Macro pour Copy décaler
'
Dim aAdrCell_Depart(7) As String
Dim aAdrCell_Arrive(7) As String
Dim lnDesti As Integer

' Tableau des adresses de départs

aAdrCell_Depart(1) = "B5:E5"
aAdrCell_Depart(2) = "G5:J5"
aAdrCell_Depart(3) = "L5:O5"
aAdrCell_Depart(4) = "Q5:T5"
aAdrCell_Depart(5) = "V5:Y5"
aAdrCell_Depart(6) = "AA5:AD5"
aAdrCell_Depart(7) = "AF5:AI5"


' Tableau des adresses d'arrivé
aAdrCell_Arrive(1) = "B11:E11"
aAdrCell_Arrive(2) = "G11:J11"
aAdrCell_Arrive(3) = "L11:O11"
aAdrCell_Arrive(4) = "Q11:T11"
aAdrCell_Arrive(5) = "V11:Y11"
aAdrCell_Arrive(6) = "AA11:AD11"
aAdrCell_Arrive(7) = "AF11:AI11"


' Index table de destination
lnDesti = 1


' boucle sur le table de départ
For lnA = 1 To 7
' Controle si une des cellule de la seleciton est rempli
If CtrlContenu(aAdrCell_Depart(lnA)) Then
Range(aAdrCell_Depart(lnA)).Select
Selection.Copy
CopySpecial (aAdrCell_Arrive(lnDesti))
lnDesti = lnDesti + 1
End If
Next




End Sub

'
'
'Copy spéciale sur avec parametre adresse de cellule
'
Sub CopySpecial(tcAdress As String)
Range(tcAdress).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

'
'
' Controle le contenu de chaque cellule
'
Function CtrlContenu(tcAdresse As String)
Dim lnReturn As Boolean
lnReturn = False
For Each Cell In Range(tcAdresse)
If Cell.Value <> "" Then
lnReturn = True
End If
Next
CtrlContenu = lnReturn
End Function



Aujourd'hui en avançant dans mon programme je dois réaliser ce même alignement avec en plus :
- un alignement gauche à l'intérieur de chaque bloc de 4 cellules
- la répétition de cette fonction sur une feuille de 12 lignes

Regarde la pièce jointe DECALER CELLULES 2.xls

Est-ce que quelqu'un peut m'aider et merci d'avance (je reste connecté derrière mon écran quelques jours car en convalescence).
Jérome.

 

[job75]

Re : alignement gauche de blocs de cellules

Bonjour jeromear,

Pour la procédure CopyDecaler, j'aurais plutôt écrit ça, nettement plus simple :

Sub CopyDecaler()
Dim tablo, n As Byte
tablo = Array("B5:E5", "G5:J5", "L5:O5", "Q5:T5", "V5:Y5", "AA5:AD5", "AF5:AI5")
For n = 0 To UBound(tablo)
  If Application.CountA(Range(tablo(n))) Then
    Range(tablo(n)).Offset(6) = Range(tablo(n)).Value
    Range(tablo(n)).Offset(6).HorizontalAlignment = xlLeft
  End If
Next
End Sub

Pour faire ça sur 12 lignes décalées de 7 :

Sub CopyDecalerBoucle()
Dim tablo, i As Byte, n As Byte
tablo = Array("B5:E5", "G5:J5", "L5:O5", "Q5:T5", "V5:Y5", "AA5:AD5", "AF5:AI5")
For i = 0 To 11
  For n = 0 To UBound(tablo)
    If Application.CountA(Range(tablo(n)).Offset(7 * i)) Then
      Range(tablo(n)).Offset(6 + 7 * i) = Range(tablo(n)).Offset(7 * i).Value
      Range(tablo(n)).Offset(6 + 7 * i).HorizontalAlignment = xlLeft
    End If
  Next
Next
End Sub

Edit : je viens seulement de regarder votre fichier. Désolé je ne comprends pas.

Avec votre code, je ne vois pas ce que vous voulez y faire.

A+

 

[jeromear]

Re : alignement gauche de blocs de cellules

Bonjour job75
sur mon fichier DECALER CELLULE 2 je cherche à obtenir en partant des données des lignes 3 à 14, un autre tableau qui se présentera comme celui du dessous (lignes 22 à 33), c'est à dire avec 2 alignements gauche successifs : une fois à l'intérieur de chaque bloc-jour, puis une autre fois par bloc entier sur chaque ligne.
(il doit y avoir jusqu'à 15 pages de ce type par fichiers, j'espère trouver une solution qui ne soit pas trop lourde)
merci pour vos aides.
jerome

 

[job75]

Re : alignement gauche de blocs de cellules

Re,

J'ai bien compris le problème et voici le fichier, ce n'était pas très facile

La macro dans le Module1 (Alt+F11) :

Sub DecalerCellules()
Dim lig As Long, n1 As Byte, n2 As Byte, col As Byte
Dim cel As Range, plage As Range, ref As Range, coljour As Byte
Application.ScreenUpdating = False
With Sheets(1)
  For lig = 3 To .Range("A65536").End(xlUp).Row
    For n1 = 1 To 7
      For n2 = 1 To 3
        col = 5 * n1 + n2 - 4
        Set cel = .Cells(lig, col)
        '---traitement des jours vides
        If n2 = 1 Then
          Set plage = cel.Resize(, 4) 'plage du jour
          If Application.CountA(plage) = 0 Then
            Set ref = .Range(cel, .Cells(lig, "AI")).Find("*", LookIn:=xlFormulas)
            If ref Is Nothing Then GoTo 2 'passe à la ligne suivante
            coljour = ref.Column - (ref.Column Mod 5) + 2 '1ère colonne du jour non vide trouvé
            Set ref = .Cells(lig, coljour).Resize(, 4) 'plage du jour non vide trouvé
            plage = ref.Value
            ref = ""
          End If
        End If
        '---traitement des cellules vides
        If cel = "" Then
          Set ref = .Range(cel, .Cells(lig, 5 * n1)).Find("*", LookIn:=xlFormulas)
          If ref Is Nothing Then GoTo 1 'passe au jour suivant
          cel = ref
          ref = ""
        End If
      Next n2
1   Next n1
2 Next lig
End With
End Sub

J'ai créé une image du tableau d'origine pour pouvoir comparer.

Je l'ai aussi sauvegardé si l'on veut faire d'autres tests.

Si vous voulez traiter plusieurs feuilles, pas difficile, faites une boucle supplémentaire sur l'index des feuilles.

A+

 

[jeromear]

Re : alignement gauche de blocs de cellules

Bonsoir Job75, cela fait 6 mois que je travaille sur ce projet et c'était l'élément qui me manquant pour le boucler. Ta macro fonctionne très bien sur ma page, dès que me remet sur pieds, je l'installe dans le programme au bureau. Merci beaucoup pour ton aide précieuse.
Jérôme
Rennes

 

[jeromear]

Re : alignement gauche de blocs de cellules

Bonjour job75
Est ce que vous pourriez m'éclairer:
Quand j'installe la macro dans mon programme excel et que je la lance, elle bogue à If cel = "" Then (erreur d'execution '13')
Il faut noter que dans le programme réél :
les colonnes sont les mêmes que dans le doc "DECALLER CELLULES" mais
-Les lignes de la page vont en fait de 10 à 24 (au lieu de 3 à 14)
-Et surtout : sous ce tableau il y à 4425 lignes de calcul.

Et que je ne suis pas une star de Vba
Merci si vous pouvez prendre un moment pour mon pb.
Jérôme
Regarde la pièce jointe COMMANDES.xls

 

[job75]

Re : alignement gauche de blocs de cellules

Bonsoir jeromear,

Cela aurait été mieux tout de même de présenter un tableau non trié. Donc je l'ai modifié.

Mais tel qu'était votre fichier, je ne constatais aucun bug

Bien sûr il faut modifier cette ligne, pas besoin d'être expert :

For lig = 10 To .Range("A65536").End(xlUp).Row

Edit : la seule chose qui fasse bugger If cel = "" Then c'est une valeur d'erreur dans la cellule étudiée...

A+

 

[job75]

Re : alignement gauche de blocs de cellules

Re,

Bon, en effet, s'il y a des valeurs d'erreur dans les cellules remplacer :

If cel = "" Then

par :

If IsEmpty(cel) Then

A+

 

[jeromear]

Re : alignement gauche de blocs de cellules

En fait cela coince quand on insère une feuille de calcul avant celle ci.
Il faut donc que "Feuil1" soit en première position dans le doc (faites le test)
Je vais formater mon doc en fonction, ce n'est pas grave
Merci Job75

 

[job75]

Re : alignement gauche de blocs de cellules

Re,

[Edit] J'ai fait le test ça ne bug pas...

Mais bien sûr jeromear, j'ai écrit au début :

With Sheets(1)

pour vous aider à créer une boucle facilement sur les feuilles

Mais si votre feuille s'appelle "TOTO", vous pouvez écrire aussi :

With Sheets("TOTO")

et là plus de problème, quelle que soit la position de la feuille...

A+

 

[jeromear]

Re : alignement gauche de blocs de cellules

Ah ben moi j'en apprends des choses.
Et pour formuler une boucle avec deux pages nommées TOTO1 et TOTO2 il faut écrire cela comment?

 

[job75]

Re : alignement gauche de blocs de cellules

Re encore,

J'ai peut-être mal interprété ceci :

-Et surtout : sous ce tableau il y à 4425 lignes de calcul.

Avec le code que je vous ai donné :

For lig = 10 To .Range("A65536").End(xlUp).Row

il faut qu'il n'y ait plus rien en colonne A sous la dernière cellule du tableau.

Sinon, eh bien modifiez la macro :

For lig = 10 To 24

Ouf !

A+

 

[job75]

Re : alignement gauche de blocs de cellules

Re,

Ah ben moi j'en apprends des choses.
Et pour formuler une boucle avec deux pages nommées TOTO1 et TOTO2 il faut écrire cela comment?

Il y a toujours à apprendre...

Il faut crééer une variable tablo et écrire :

Sub DecalerCellules()
Dim lig As Long, n1 As Byte, n2 As Byte, col As Byte
Dim cel As Range, plage As Range, ref As Range, coljour As Byte
[COLOR="red"]Dim tablo, i As Byte[/COLOR]
Application.ScreenUpdating = False
[COLOR="Red"]tablo = Array("TOTO1", "TOTO2")[/COLOR]
For i = 0 To UBound(tablo)
With Sheets(tablo(i))
'-------------------------
Next i
End Sub

Dans les feuilles les tableaux devront commencer à la même ligne.

PS : j'espère que vous avez bien lu tous mes posts précédents ??

A+

 

[jeromear]

Re : alignement gauche de blocs de cellules

Bien sur Job j'effectue pas à pas toutes les améliorations que vous me procurez.

Et je n'arrive pas à installer cette boucle!

En copiant ce code au début de la macro, cela me donne le message "Next sans for"

j'ai du rater qqchose:
Ps : mes feuilles s'appellent 4temps1 et 4temps2



Sub DecalerCellules()
Dim lig As Long, n1 As Byte, n2 As Byte, col As Byte
Dim cel As Range, plage As Range, ref As Range, coljour As Byte
Dim tablo, i As Byte
Application.ScreenUpdating = False
tablo = Array("4temps1", "4temps2")
For i = 0 To UBound(tablo)
With Sheets(tablo(i))
'-----------------------------
Next i
End Sub

For lig = 10 To 24
For n1 = 1 To 7
For n2 = 1 To 3
col = 5 * n1 + n2 - 4
Set cel = .Cells(lig, col)
'---traitement des jours vides
If n2 = 1 Then
Set plage = cel.Resize(, 4) 'plage du jour
If Application.CountA(plage) = 0 Then
Set ref = .Range(cel, .Cells(lig, "AI")).Find("*", LookIn:=xlFormulas)
If ref Is Nothing Then GoTo 2 'passe à la ligne suivante
coljour = ref.Column - (ref.Column Mod 5) + 2 '1ère colonne du jour non vide trouvé
Set ref = .Cells(lig, coljour).Resize(, 4) 'plage du jour non vide trouvé
plage = ref.Value
ref = ""
End If
End If
'---traitement des cellules vides
If IsEmpty(cel) Then
Set ref = .Range(cel, .Cells(lig, 5 * n1)).Find("*", LookIn:=xlFormulas)
If ref Is Nothing Then GoTo 1 'passe au jour suivant
cel = ref
ref = ""
End If
Next n2
1 Next n1
2 Next lig
End With
End Sub

 

[job75]

Re : alignement gauche de blocs de cellules

Re,

Je pensais que ça allait de soi

[COLOR="Red"]Sub DecalerCellules()
Dim lig As Long, n1 As Byte, n2 As Byte, col As Byte
Dim cel As Range, plage As Range, ref As Range, coljour As Byte
Dim tablo, i As Byte
Application.ScreenUpdating = False
tablo = Array("TOTO1", "TOTO2") 'nombre de feuilles étudiées limité à 255, sinon => i As Integer
For i = 0 To UBound(tablo)
With Sheets(tablo(i))[/COLOR]
  For lig = 10 To .Range("A65536").End(xlUp).Row 'ou : For lig = 10 To 24
    For n1 = 1 To 7
      For n2 = 1 To 3
        col = 5 * n1 + n2 - 4
        Set cel = .Cells(lig, col)
        '---traitement des jours vides
        If n2 = 1 Then
          Set plage = cel.Resize(, 4) 'plage du jour
          If Application.CountA(plage) = 0 Then
            Set ref = .Range(cel, .Cells(lig, "AI")).Find("*", LookIn:=xlFormulas)
            If ref Is Nothing Then GoTo 2 'passe à la ligne suivante
            coljour = ref.Column - (ref.Column Mod 5) + 2 '1ère colonne du jour non vide trouvé
            Set ref = .Cells(lig, coljour).Resize(, 4) 'plage du jour non vide trouvé
            plage = ref.Value
            ref = ""
          End If
        End If
        '---traitement des cellules vides
        If IsEmpty(cel) Then
          Set ref = .Range(cel, .Cells(lig, 5 * n1)).Find("*", LookIn:=xlFormulas)
          If ref Is Nothing Then GoTo 1 'passe au jour suivant
          cel = ref
          ref = ""
        End If
      Next n2
1   Next n1
2 Next lig
End With
[COLOR="red"]Next i
End Sub[/COLOR]

A+