... Doublons Dans Une Liste - JD

Bonjour,

Une solution à votre problème avec le code ci-dessous:

'********************************
Option Explicit
Type structTbl
T() As Variant
End Type
'______________________________
Sub OccurrencesPlage()
Dim NomFeuil$
Dim Plage$
Dim R As Range
Dim nbCol&
Dim nbLig&
Dim var
Dim i&
Dim j&
Dim k&
Dim nbEmpty&
Dim occur&
Dim totalOcc&
Dim cpt&
Dim TABL() As structTbl
Dim Tempo()
On Error GoTo Erreur
Set R = Application.InputBox _
(prompt:="Sélectionnez votre plage", _
Title:="Statistiques de plage", Type:=8)
NomFeuil$ = R.Parent.Name
Plage$ = R.Address(rowabsolute:úlse, _
columnabsolute:úlse)
If InStr(1, Plage$, ",") Then
MsgBox "Plages multiples interdites."
Exit Sub
End If
nbLig& = R.Rows.Count
nbCol& = R.Columns.Count
If nbLig& = 1 And nbCol& = 1 Then Exit Sub
Sheets.Add before:=Sheets(1)
var = R
Range(Cells(1, 1), Cells(nbLig&, nbCol&)) = var
ReDim TABL(1 To nbCol&)
For j& = 1 To nbCol&
ReDim TABL(j&).T(-5 To 0)
nbEmpty& = 0
occur& = 1
totalOcc& = 0
cpt& = 0
Range(Cells(1, 1), Cells(nbLig&, nbCol&)).Sort _
Key1:=Range(Cells(1, j&), Cells(1, j&)), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:úlse, _
Orientation:=xlTopToBottom
var = Range(Cells(1, j&), Cells(nbLig& + 1, j&))
For i& = 1 To nbLig& + 1
If i& = nbLig& + 1 Then Exit For
If IsEmpty(var(i&, 1)) Then
nbEmpty& = nbEmpty& + 1
Else
If var(i&, 1) = var(i& + 1, 1) Then
occur& = occur& + 1
Else
If occur& > 1 Then
cpt& = cpt& + 1
ReDim Preserve TABL(j&).T(-5 To cpt&)
TABL(j&).T(cpt&) = _
occur& & " fois " & var(i&, 1)
totalOcc& = totalOcc& + occur&
occur& = 1
End If
End If
End If
Next i&
With TABL(j&)
.T(-5) = nbEmpty&
.T(-4) = nbLig& - nbEmpty&
.T(-3) = nbLig&
.T(-1) = totalOcc&
End With
Next j&
Cells.Delete
For j& = 1 To nbCol&
cpt& = 0
With TABL(j&)
ReDim Tempo(1 To Abs(LBound(.T)) + _
UBound(.T) + 1, 1 To 1)
For i& = LBound(.T) To UBound(.T)
cpt& = cpt& + 1
Tempo(cpt&, 1) = .T(i&)
Next i&
Range(Cells(4, j& + 1), _
Cells(UBound(Tempo, 1) + 3, j& + 1)) = Tempo
End With
Next j&
[a1] = "Statistiques de la feuille " & NomFeuil$
[a2] = "Plage concernée: " & Plage$
[a4] = "Nb de cellules vides"
[a5] = "Nb de cellules pleines"
[a6] = "Nb de cellules. Total"
[a8] = "Total des occurrences"
[a10] = "Occurrences"
Set R = Range("a1:a10")
With R.Font
.Bold = True
.ColorIndex = 5
.Underline = True
End With
Cells.Columns.AutoFit
Exit Sub
Erreur:
End Sub
'************************

Je vous adresse un classeur exemple pour tester.

Dites-moi si ça fonctionne bien chez vous.

Cordialement.

PMO
Patrick Morange

Salut,

Ma question est là, comment automatiser les résultats des colonnes B11
à D21? Je vais essayer de m'y coller, mais si quelqu'un a une solution
je l'écoute bien volontiers. Merci d'avance. Les réponses peuvent être
envoyées à : jacquesdubler@hotmail.com

Salutations & Merci.


A B C D
1 Colonne Colonne Colonne
numérique alphabétique aplhanumérique
2 123 art
3 elod 12safi
4 789 34rebu
5 456 art 12safi
6 123 34rebu
7 2 art 12safi
8 elira
9 123 elira kalo58
10 pasu

11 Nbre de cellules vides 3 2 3
12 Nbre de cellules pleines 6 7 6
13 Nbre de cellules total 9 9 9

15 Nbre de cellules pleine
dont contenu est identique 3 5 5

17 Doublon no 0001 123 art 12safi
18 Doublon no 0002 elira 34rebu
19 Doublon no 0003 etc etc etc
20 etc etc etc etc
21 etc etc etc etc