Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Sub ventiler()
'Base est la colonne de début
Const Base = "M"
Dim Source, Lettres$(), Numeros(), i&, n&, j&, j2&, s$, Col&
Dim ligne&, cpt&, max&
Application.ScreenUpdating = False
'lecture du tableau Source
Source = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 9).Value
'ajoute une colonne au tableau source
ReDim Preserve Source(1 To UBound(Source), 1 To 10)
'lecture des numéros sans doublons
'et dans la colonne 10 de Source, on met le numéro
ReDim Numeros(0 To 99)
For i = 1 To UBound(Source)
n = Val("0" & Right(Source(i, 9), 2))
Numeros(n) = n
Source(i, 10) = n
Next i
'lecture des lettres sanns doublons
'et dans la colonne 9 de Source, on met la lettre en majuscule
ReDim Lettres(1 To 26)
For i = 1 To UBound(Source)
s = UCase(Left(Source(i, 9), 1))
Lettres(Asc(s) - 64) = s
Source(i, 9) = s
Next i
'effacement des colonnes de résultats
Range(Cells(1, Range(Base & 1).Column), Cells(1, Range(Base & 1).Column + 26)).EntireColumn.ClearContents
'ligne où commencer l'écriture pour un début de numéro
ligne = 2
For n = 1 To 99 'boucle sur les numros possibles
If Numeros(n) > 0 Then
'le numéro existe dans la Source
Col = Range(Base & 1).Column 'numéro de la colonne d'écriture pour le numéro
Cells(ligne, Col).NumberFormat = "00" 'écriture du numero
Cells(ligne, Col) = Format(Numeros(n), "00") 'format du numero
For j = 1 To 26 'boucle sur les lettres
If Len(Lettres(j)) > 0 Then
'la lettre existe dans la Source
Col = Col + 1 'numéro de la prochaine colonne d'écriture pour la 1ière lettre
Cells(1, Col) = Lettres(j) 'écriture de la lettre en ligne 1
cpt = ligne 'prochaine ligne où écrire RASCL et LOCCL
For i = 1 To UBound(Source) 'boucle sur la source
If Source(i, 9) = Lettres(j) And Source(i, 10) = Numeros(n) Then
' le code correspond au numéro en cours de traitement
' et à la lettre en cours de traitement
Cells(cpt, Col) = Source(i, 2) 'écriture de RASCL
Cells(cpt, Col + 1) = Source(i, 3) 'écriture de LOCCL
cpt = cpt + 1 'prochaine ligne d'écriture
End If
'max est la ligne max d'écriture pour le numéro en cours
If cpt > max Then max = cpt
Next i
'on vient de traiter une lettre, on incrémente la colonne de 1
'en fait, il faut l'incrémenter de 2
' le second incrément se fait au début de la boucle j
Col = Col + 1
End If
Next j
' on vient de traiter un numéro on saute quelques lignes
ligne = 2 + max + 1
max = 0
End If
Next n
Application.ScreenUpdating = True
End Sub
