Incrémenter 2 variables lig et col

[cibleo]

Bonjour le forum,

Pour bien comprendre, voyez le résultat obtenu en cliquant en Feuil4.

Sub Split_Transpose_Desserte1()
'En colonne A, les donnees à splitter
Dim C As Range, Item As Variant, col As Long, lig As Long
Application.ScreenUpdating = False
col = 2
For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  lig = 2
  temp = Replace(C, ", ", " - ")
  For Each Item In Split(C.Value, ", ")
    Cells(lig, col) = Item
    lig = lig + 1
  Next Item
  '''Mise en Forme
  'Blablabla
   Cells(2, col).Offset(, 1).Resize(1, 3).Value = "-"
  '''Fin de la mise en forme
  col = col + 4
Next C
Application.ScreenUpdating = True
'lig = Feuil4.Range("B" & Rows.Count).End(xlUp).Row + 2
End Sub

Maintenant, j'aimerais obtenir ce qui est illustré en Feuil2.
Je n'arrive pas à modifier les variables lig et col pour obtenir une transposition par bloc de 3
Pouvez-vous m'éclairer ?

Cibleo

 

[Sheldor]

Re : Incrémenter 2 variables lig et col

bonjour,

col = col + 4

If col = 14 Then col = 2

Next C

le retour à 2 si = 14 permet de revenir à gauche mais il faut aussi avoir une variable pour descendre dans les lignes, par contre je ne comprends pas tout votre code
je regarde

amicalement

 

[Sheldor]

Re : Incrémenter 2 variables lig et col

par contre il peut y avoir plus que deux villes par cellules?

 

[Sheldor]

Re : Incrémenter 2 variables lig et col

petite correction

 

[cibleo]

Re : Incrémenter 2 variables lig et col

Bonjour nicopec,

C'est parfait dans ce cas là :
Mais comme tu le soulignes dans le post #3, il peut y avoir plusieurs items dans chaque cellule.
La variable incrément qui est un multiple de 4 va donc nous poser un nouveau problème

If col = 14 Then
  col = 2
  increment = increment + 4
End If
Next C

Je sèche encore
La finalité c'est de laisser une ligne vide entre chaque blocs consécutifs donc se baser sur la derniere cellule pleine de chaque blocs.

Cibleo

 

[job75]

Re : Incrémenter 2 variables lig et col

Bonjour cibleo, nicopec,

Voyez cette macro dans le fichier joint :

Sub Split_Transpose_Desserte()
Dim lig As Long, i As Long, t(2, 11), n As Byte, s
Application.ScreenUpdating = False
Range("B4:M" & Rows.Count).Clear 'RAZ
lig = 1
For i = 1 To 11
  t(1, i) = "-"
Next
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1
  n = (i - 1) Mod 3
  If n = 0 And i > 1 Then
    [B1:M3].Copy Cells(lig, 2)
    Cells(lig, 2).Resize(3, 12) = t
    lig = lig + 4
  End If
  s = Split(Cells(i, 1) & ", ", ", ") 'au moins 2 éléments
  t(0, 4 * n) = "Trajet : " & s(0) & " - " & s(1)
  t(1, 4 * n) = s(0): t(2, 4 * n) = s(1)
Next
End Sub

Nota 1 : le formatage de la plage B1:M3 est copié dans les autres tableaux, donc ne pas l'effacer.

Nota 2 : le tableau VBA t est défini en base 0.

A+

 

[job75]

Re : Incrémenter 2 variables lig et col

Re,

S'il y a des lignes avec des titres il faut bien sûr adapter la macro.

Fichier (2).

A+

 

[Sheldor]

Re : Incrémenter 2 variables lig et col

bonjour tout le monde,
cibleo est ce que ce dernier fichier de job fonctionne pour toi? je ne suis pas sûr d'avoir compris mais si je rajoutte une troisième ville quelque part il ne la prend pas on dirait

à+

 

[Sheldor]

Re : Incrémenter 2 variables lig et col

suite
je n'ai pas eu le temps de mettre les bordures propres mais voilà un essai avec plusieurs villes

 

[job75]

Re : Incrémenter 2 variables lig et col

Bonjour cibleo, nicopec, le forum,

Je repasse par ici car je ne m'étais pas occupé du cas où il y a des groupes de plus de 2 villes dans la liste.

Voyez le fichier (3) joint.

La macro crée une nouvelle liste avec toujours des groupes de 2 villes.

A+

 

[cibleo]

Re : Incrémenter 2 variables lig et col

Bonsoir à tous,
Bonsoir job75, nicopec

Voilà, j'ai procédé en traitant cellule par cellule.
Les cellules peuvent éventuellement ne pas contenir le même nombre de villes, ce que je n'avais pas préciser dès le départ
D'où une mise en forme bloc par bloc, c'est moins rapide mais bon !
Voir la macro complète dans le module2 :

Sub Split_Transpose_Desserte4()
'En colonne A, les donnees à splitter
Dim C As Range, Item As Variant, lig As Long
Dim lig1 As Long, col As Byte, h As Byte
Application.ScreenUpdating = False
lig = 2: col = 2
For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  lig1 = lig
  temp = Replace(C, ", ", " - ")
  For Each Item In Split(C.Value, ", ")
    Cells(lig1, col) = Item
    lig1 = lig1 + 1
  Next Item
  h = lig1 - lig
  'Mise en Forme
  '..........
  'Fin de la Mise en Forme
  col = col + 4
  If col = 14 Then
    lig = [B2:M200].Find("*", , , , xlByRows, xlPrevious).Row + 3
    col = 2
  End If
Next C
Application.ScreenUpdating = True
End Sub

Job75 : je vais analyser tout ça tranquillement comme d'habitude (variables tableau, redim preserve)
nicopec : merci pour ton éclairage qui m'a permis de corriger ma copie.

Merci à tous Cibleo