Doublons + msgbox

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 #18706101
tu as ta réponse à la même question que tu as posé hier.



"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
LSteph
Le #18707661
Bonjour,

si la source est dans une feuille et que la finalité est de mettre le
résultat dans des cellules
plus besoin de tableau ni msgbox ni de monter une usine à gaz en vba
il serait bien plus simple d'utiliser le Filtre Elaboré
Extraction sans doublons.


Cordialement.

--
lSteph

oliver a écrit :
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



Publicité
Poster une réponse
Anonyme