Doublons

Le
oliver
Bonsoir,
j'utilise la macro ci-dessous pour dénombrer les doublons. Le résultats est
restitué dans une MsgBox, comment faire pour qu'il apparaisse dans une
feuille de calcul en incrémentant à partir de la cellule A1?
Merci
Sub CompterLesNomsIdentiques()
Dim Cell As Range
Dim Ligne As Integer, I As Integer
Dim M As Byte
Dim U As Boolean
Dim Tableau()
Dim Resultat As String

Ligne = Range("A65536").End(xlUp).Row
M = 1
ReDim Preserve Tableau(2, M)

For Each Cell In Range("B4:B" & Ligne)
U = False
For I = 1 To M
If Cell = Tableau(0, I - 1) Then
Tableau(1, I - 1) = Tableau(1, I - 1) + 1
U = True
End If
Next I

If Tableau(1, M - 1) = "" And U = False Then
Tableau(0, M - 1) = Cell
Tableau(1, M - 1) = 1
M = M + 1
ReDim Preserve Tableau(2, M)
End If
Next Cell

For I = 1 To M - 1
Resultat = Resultat & Tableau(0, I - 1) & Chr(9) & Tableau(1, I - 1) &
Chr(10)
Next I
MsgBox Resultat

End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #18697561
Pour afficher le résultat à partir de la cellule G1
Tu places ceci à la fin du code avant le msgbox

With Worksheets("Feuil1") 'nom feuille à adapter
'de manière horizontale
.Range("G1").Resize(UBound(Tableau, 1), UBound(Tableau, 2)) = _
Tableau
'De manière verticale
.Range("G1").Resize(UBound(Tableau, 2), UBound(Tableau, 1)) = _
Application.Transpose(Tableau)
End With




"oliver" O5f$
Bonsoir,
j'utilise la macro ci-dessous pour dénombrer les doublons. Le résultats est
restitué dans une MsgBox, comment faire pour qu'il apparaisse dans une
feuille de calcul en incrémentant à partir de la cellule A1?
Merci
Sub CompterLesNomsIdentiques()
Dim Cell As Range
Dim Ligne As Integer, I As Integer
Dim M As Byte
Dim U As Boolean
Dim Tableau()
Dim Resultat As String

Ligne = Range("A65536").End(xlUp).Row
M = 1
ReDim Preserve Tableau(2, M)

For Each Cell In Range("B4:B" & Ligne)
U = False
For I = 1 To M
If Cell = Tableau(0, I - 1) Then
Tableau(1, I - 1) = Tableau(1, I - 1) + 1
U = True
End If
Next I

If Tableau(1, M - 1) = "" And U = False Then
Tableau(0, M - 1) = Cell
Tableau(1, M - 1) = 1
M = M + 1
ReDim Preserve Tableau(2, M)
End If
Next Cell

For I = 1 To M - 1
Resultat = Resultat & Tableau(0, I - 1) & Chr(9) & Tableau(1, I - 1) &
Chr(10)
Next I
MsgBox Resultat

End Sub
Nico
Le #18702471
On 17 fév, 22:43, "oliver"
Bonsoir,
j'utilise la macro ci-dessous pour dénombrer les doublons. Le résulta ts est
restitué dans une MsgBox, comment faire pour qu'il apparaisse dans une
feuille de calcul en incrémentant à partir de la cellule A1?
    Merci
Sub CompterLesNomsIdentiques()
Dim Cell As Range
Dim Ligne As Integer, I As Integer
Dim M As Byte
Dim U As Boolean
Dim Tableau()
Dim Resultat As String

Ligne = Range("A65536").End(xlUp).Row
M = 1
ReDim Preserve Tableau(2, M)

For Each Cell In Range("B4:B" & Ligne)
U = False
For I = 1 To M
If Cell = Tableau(0, I - 1) Then
Tableau(1, I - 1) = Tableau(1, I - 1) + 1
U = True
End If
Next I

If Tableau(1, M - 1) = "" And U = False Then
Tableau(0, M - 1) = Cell
Tableau(1, M - 1) = 1
M = M + 1
ReDim Preserve Tableau(2, M)
End If
Next Cell

For I = 1 To M - 1
Resultat = Resultat & Tableau(0, I - 1) & Chr(9) & Tableau(1, I - 1) &
Chr(10)
Next I
MsgBox Resultat

End Sub



salut
Pourquoi ne pas utiliser directement la commande filtres elaborés ?
Il suffit de faire références à la meme plage de données en zone de
critères et en zone de recherche en cochant la case... doublons
puis d'indiquer une cellule vierge pour recevoir la liste épurée
Publicité
Poster une réponse
Anonyme