Calcul de couple de valeurs d'une plage

moteurV12

XLDnaute Occasionnel
Bonjour à tous,

Voici un fichier qui doit calculer les couples de valeurs dans une plage.
Le code vba entièrement paramétrable suivant les besoins, me semblait pourtant optimisé, mais lorsque je fais un test de comptage de couple de valeurs, le résultat est faux.

Dans l'exemple j'ai volontairement mis le 1 et le 3 dans toutes les combinaisons de chiffre et surprise sur 245 lignes il ne trouve le couple 1 - 3 que 151 fois.

Forcément une erreur c'est glissé dans le code mais je ne vois pas.

Merci de m'éclairer de vos lumières.
 

Pièces jointes

  • calcul de couple valeurs.xls
    71 KB · Affichages: 41
Dernière édition:

moteurV12

XLDnaute Occasionnel
Re : Calcul de couple de valeurs d'une plage

Je vous joint un fichier avec 2 feuilles dont la base de données est differente, mais pour un résultat identique afin d'essayer de mieux me faire comprendre.
 

Pièces jointes

  • SONDE1.xls
    213 KB · Affichages: 21
Dernière édition:

job75

XLDnaute Barbatruc
Re : Calcul de couple de valeurs d'une plage

Re,

Je ne comprends pas ce que vous faites de vos cumuls en colonne S et d'ailleurs je n'en vois pas l'intérêt.

Alors pour moi ce fichier (4) sera le dernier exercice.

En cellule R1 on paramètre le nombre de couples les plus fréquents à prendre en compte.

La macro colore en jaune dans la BDD les lignes qui contiennent ces couples :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union([A:E], [R1])) Is Nothing Then Exit Sub
Dim P As Range, c As Range, n&, r As Range, Q As Range
Application.ScreenUpdating = False
Set P = [A2].CurrentRegion.Rows
P.Interior.ColorIndex = xlNone 'RAZ
For Each c In Range("P2", Range("P" & Rows.Count).End(xlUp))
  n = 0
  For Each r In P
    If Application.CountIf(r, c) Then _
      If Application.CountIf(r, c(, 2)) Then n = n + 1
  Next
  c(, 0) = n
Next
[O:Q].Sort [O1], xlDescending, Header:=xlYes 'tri sur colonne O
If Val([R1]) < 1 Then Exit Sub
Set Q = [P2].Resize(Val([R1]))
For Each r In P
  For Each c In Q
    If Application.CountIf(r, c) = 0 Then GoTo 1
    If Application.CountIf(r, c(, 2)) = 0 Then GoTo 1
  Next
  r.Cells.Interior.ColorIndex = 6 'jaune
1 Next
End Sub
A+
 

Pièces jointes

  • calcul de couple valeurs(4).xls
    62.5 KB · Affichages: 30

moteurV12

XLDnaute Occasionnel
Re : Calcul de couple de valeurs d'une plage

Je vous remercie d'avoir consacré de votre temps à mon problème et pour la qualité de votre code en ce qui concerne la 1er partie de ce fichier.
Pour le reste, C'est justement sur la colonne S que réside tous l'intérêt du fichier.

Sujet plus que jamais ouvert aux âmes courageuses.
 

Discussions similaires

Statistiques des forums

Discussions
312 393
Messages
2 088 008
Membres
103 699
dernier inscrit
samSam31