combinaison de chiffre

[seydou86]

bonjour a tous

est ce possible , facilement , de savoir si des combinaison sortent plusieurs fois.


dans l'ordre , ou le désordre. peu importe.

 

[job75]

Re : combinaison de chiffre

Re,

Si l'on veut compter le nombre de doublons on peut utiliser cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, nlig&, ncol%, decal&, a%(), b%(), c()
Dim d As Object, i&, lig, x$, j%
Set P = [deb].CurrentRegion
nlig = P.Rows.Count
If Intersect(Target, P.Resize(nlig + 1)) Is Nothing Then Exit Sub
ncol = P.Columns.Count
decal = P.Row - 1
ReDim a(1 To nlig + decal, 1 To 1)
ReDim b(1 To nlig + decal, 1 To 1)
ReDim c(1 To nlig + decal, 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
  lig = P.Rows(i)
  tri lig, 1, ncol
  x = ""
  For j = 1 To ncol
    x = x & " " & lig(1, j)
  Next
  If d.exists(x) Then
    a(i + decal, 1) = 1
    b(d(x), 1) = 1
    c(d(x), 1) = c(d(x), 1) + 1
    c(i + decal, 1) = "Voir ligne " & d(x)
  Else
    d(x) = i + decal
    c(d(x), 1) = 1
  End If
Next
ThisWorkbook.Names.Add "PremiereLigneDoublon", b 'nom défini
ThisWorkbook.Names.Add "AutreLigneDoublon", a 'nom défini
ThisWorkbook.Names.Add "Comptage", c 'nom défini
End Sub

Le double-clic sur une ligne rose donne le nombre de doublons, sur une ligne jaune le n° de la 1ère ligne :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row > Application.CountA([Comptage]) Or Target.Row < [deb].Row Then Exit Sub
Dim x
Cancel = True
x = Application.Index([Comptage], Target.Row, 1)
MsgBox IIf(Val(x) = 1, "Pas de doublon...", IIf(Val(x), "Nombre de doublons : ", "") & x)
End Sub

Fichier (3).

A+

 

[job75]

Re : combinaison de chiffre

Re,

Je n'avais pas fait attention mais quand les formules des 3 noms définis dépassent 8192 caractères le fichier ne peut pas être enregistré.

Dans ce cas il faut stocker les listes a b c dans la feuille auxiliaire "Listes" et nommer les plages.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row > [Comptage].Count Or Target.Row < [deb].Row Then Exit Sub
Dim x
Cancel = True
x = [Comptage].Cells(Target.Row)
MsgBox IIf(Val(x) = 1, "Pas de doublon...", IIf(Val(x), "Nombre de doublons : ", "") & x)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, nlig&, ncol%, decal&, a%(), b%(), c()
Dim d As Object, i&, lig, x$, j%
Set P = [deb].CurrentRegion
nlig = P.Rows.Count
If Intersect(Target, P.Resize(nlig + 1)) Is Nothing Then Exit Sub
ncol = P.Columns.Count
decal = P.Row - 1
ReDim a(1 To nlig + decal, 1 To 1)
ReDim b(1 To nlig + decal, 1 To 1)
ReDim c(1 To nlig + decal, 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
  lig = P.Rows(i)
  tri lig, 1, ncol
  x = ""
  For j = 1 To ncol
    x = x & " " & lig(1, j)
  Next
  If d.exists(x) Then
    a(i + decal, 1) = 1
    b(d(x), 1) = 1
    c(d(x), 1) = c(d(x), 1) + 1
    c(i + decal, 1) = "Voir ligne " & d(x)
  Else
    d(x) = i + decal
    c(d(x), 1) = 1
  End If
Next
With Feuil2 'CodeName
  .Range("A1:C" & .Rows.Count).ClearContents 'RAZ
  .[A1].Resize(nlig + decal) = b: .[A1].Resize(nlig + decal).Name = "PremiereLigneDoublon"
  .[B1].Resize(nlig + decal) = a: .[B1].Resize(nlig + decal).Name = "AutreLigneDoublon"
  .[C1].Resize(nlig + decal) = c: .[C1].Resize(nlig + decal).Name = "Comptage"
End With
End Sub

Fichier (4).

Edit : allez une petite mesure :

- 790 lignes => 0,11 seconde

- 7900 lignes => 0,42 seconde

- 79000 lignes => 3,2 secondes.

Bonne soirée.

A+

 

[job75]

Re : combinaison de chiffre

Bonjour le forum,

Voyez ce fichier (4 bis) avec restitution du tableau c dans la 1ère feuille.

Bonne journée.

 

[job75]

Re : combinaison de chiffre

Re,

Cette macro permet de remplir le tableau avec des nombres entiers aléatoires :

Sub Tirage()
'se lance par Ctrl+T
Dim borne1, borne2, nlig&, ncol%, t(), e, d As Object, i&, j%, n
borne1 = 1 'à adapter
borne2 = 20 'à adapter
nlig = 5000 'à adapter
ncol = 5 'à adapter
ReDim t(1 To nlig, 1 To ncol)
e = borne2 - borne1 + 1
Set d = CreateObject("Scripting.Dictionary")
'---nombres aléatoires sans doublons sur 1 ligne---
Randomize
For i = 1 To nlig
  d.RemoveAll
  For j = 1 To ncol
    Do
      n = borne1 + Int(Rnd * e)
    Loop While d.exists(n)
    d(n) = "": t(i, j) = n
Next j, i
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False
[deb].Offset(nlig).Resize(Rows.Count - nlig - [deb].Row + 1, ncol).Delete xlUp
Application.EnableEvents = True
With [deb].Resize(nlig, ncol)
  .Value = t
  .Interior.Color = 13995347 'bleu
  .Borders.Weight = xlThin
End With
End Sub

Fichier joint avec 5000 lignes.

Edit 1 : durées d'exécution sur Win 8 - Excel 2013 :

- 1000 lignes => 0,09 seconde

- 5000 lignes => 0,39 seconde

- 25000 lignes => 1,90 seconde

- 125000 lignes => 10,2 secondes.

Edit 2 : si l'on veut lancer la macro par une seule touche, par exemple F9, voir le fichier (1 bis) et les macros dans ThisWorkbook.

A+

 

[laleub]

Re : combinaison de chiffre

bonsoir

pourriez vous adapter ce fichier " plusieur fois 4 bis" pour 20 colonnes et 70 numéro de 1 a 70
merci
laleub