Sub InsererEtIndicer()
Dim rgRef As Range, rgOu As Range
Dim T1, T(), i, j, k, N
'rgRef est l'objet range qui sera la zone qui décrit les éléments à insérer et leur nombre
'Remise à zéro de rgRef
Set rgRef = Nothing
'Si on appuie sur 'Annuler' dans la boîte de dialogue, alors VBA provoque une erreur, on indique à VBA de
' continuer à l'instruction suivante en cas d'erreur
On Error Resume Next
'utilisation de la fonction 'Application.InputBox' qui retourne une valeur
' Type:=8 indique qu'on retourne un range - le range sélectionné est affecté à rgRef
Set rgRef = Application.InputBox("Sélectionner la zone (Noms+Nbr lignes) =?" & vbLf & _
vbLf & " ( ligne d'en-tête comprise ) ", Type:=8)
'on rétablit la gestion d'erreur
On Error GoTo 0
'si on a annulé, rien n'aura été affecté à rgRef et donc rgRef conservera sa valeur initiale (nothing)
If rgRef Is Nothing Then
'rgRef est égal à nothing, l'utilisateur a donc annuler ==> on quitte le programme
MsgBox "Aucune zone choisie"
Exit Sub
End If
'on n'a pas annulé ==> on demande la saisie de la cellule destination (idem ci-dessus
Set rgOu = Nothing
On Error Resume Next
Set rgOu = Application.InputBox("sélectionner la cellule de destination =?" & vbLf & _
vbLf & " (Ce peut être une cellule de la précédente zone " & vbLf & _
"par exemple la cellule d'en-tête de la 1ière colonne)", Type:=8)
On Error GoTo 0
If rgOu Is Nothing Then
MsgBox "Aucune cellule choisie"
Exit Sub
End If
' On affecte à la varianle T1 les valeurs de la zone de description
' T1 sera un tableau à deux colonnes et autant de lignes que la zone rgRef
' T(1,1) et T(1,2) contiennent les en-têtes de la zone
T1 = rgRef.Value
' On compte le nombre de cellules dans la colonne résultat (en-tête non comprise) - on commence à la ligne 2
' et on va jusqu'à la fin du nombre de ligne de la zone rgRef ==> rgRef.Columns("A").Cells.Count
' sur la feuille, c'est la somme de la colonne B.
For i = 2 To rgRef.Columns("A").Cells.Count
N = N + T1(i, 2)
Next i
' si il y a au moins un élément à insérer dans la colonne
If N > 0 Then
'on redimensionne le tableau T au nombre de cellules du résultat
ReDim T(1 To N)
'on va boucler sur le tableau T1 pour aller remplir le tableau résultat T
'k sera désigne l'indice du tableau T qu'on va compléter
k = 0
'On boucle sur les lignes de T1 (en excluant la ligne des en-têtes)
For i = 2 To rgRef.Rows.Count
'Pour chaque ligne i du tableau T, on boucle sur le nombre de fois ( T1(i,2) ) où on doit écrire
' le nom ( T1(i,1) ) avec son indice j
' T1(i,2) contient le nombre de fois où écrire l'élément T1(i,1)
For j = 1 To T1(i, 2)
'on incrémente k
k = k + 1
'on met dans T(k) le nom et son indice
T(k) = T1(i, 1) & " (" & j & ")"
Next j 'indice suivant
Next i ' ligne suivante
'on a complété T le tableau résultat - il faut maintenant l'inscrire sur la feuille
' pour cela on part de la cellule de destination rgOu
' on la déplace d'une ligne vers le bas
' et on la redimensionne au nombre d'élément de T (soit N)
' on affecte à cette zone le tableau T - mais comme le tableau T est un tableau à 1 dimension,
' il est stocké "en ligne". Comme le résultat est en colonne, il faut transposer T de ligne en colonne.
' c'est ce que fait Application.Transpose
If N > 0 Then rgOu.Offset(1).Resize(N) = Application.Transpose(T)
End If
' enfin, dans la cellule de destination, on met l'en-tête.
rgOu = rgRef(1, 1)
End Sub
