Sujet Précédent Sujet Suivant

Comparaison d'ensembles de données - Matrice - VBA

Fermé
Jack russel - 17 avril 2014 à 12:07
 Jack russel - 17 avril 2014 à 16:55
Bonjour,

Mon problème est le suivant:

J'ai deux feuilles excel, chacune contenant un tableau similaire dans sa construction mais contenant des données différentes.

J'aimerais comparer les données de ces deux tableaux, et plus précisément repérer les combinaisons nouvelles entre deux colonnes qui m'intéressent particulièrement.

Admettons que les colonnes 1 et 2 m'intéressent. Nous avons sur une ligne une combinaison de deux données sur les colonnes 1 et 2. J'aimerais vérifier que dans une autre feuille, contenant un tableau similaire donc, si cette même combinaison apparait au moins une fois. Si ce n'est pas le cas, c'est que cette combinaison est nouvelle! Et si elle est nouvelle il faut pouvoir la réécrire dans une autre feuille encore, afin de créer au final une liste de nouvelles combinaisons.

Je joins à cette demande un fichier .xlsm afin d'illustrer mon problème:
http://cjoint.com/?DDrl3vI4ENz

J'ai déjà pas mal réfléchi à mon problème, voici le code (que j'ai adapté dans le fichier exemple):


Sub Comparaison()

Dim LineN As Integer
Dim LineNm As Integer
Dim LastLineN As Integer
Dim LastLineNm As Integer
Dim Lettren As String
Dim Lettrenm As String
Dim Chiffren As String
Dim Chiffrenm As String
Dim Nbreapparition As Integer
Dim LineRes As Integer

LastLineN = Sheets("n").Range("A65536").End(xlUp).Row
LastLineNm = Sheets("av").Range("A65536").End(xlUp).Row
LineRes = 2

For LineN = 2 To LastLineN Step 1
Lettren = Sheets("n").Cells(LineN, 1)
Chiffren = Sheets("n").Cells(LineN, 2)
Nbreapparition = 0

For LineNm = 2 To LastLineNm Step 1
If Sheets("av").Cells(LineNm, 1).Value = Lettren And Sheets("av").Cells(LineNm, 2).Value = Chiffren Then
Nbreaparition = Nbreaparition + 1
End If
Next LineNm
If Nbreaparition = 0 Then
Sheets("Résultat").Cells(LineFiche, 1).Value = Lettren
Sheets("Résultat").Cells(LineFiche, 3).Value = Chiffren
LineRes = LineRes + 1
End If
Next LineN
End Sub

Mais ce code ne fonctionne pas! Il me sort n'importe quoi, ne détecte pas les nouvelles combinaisons...

J'ai pensé qu'il faudrait utiliser les fonctions d'analyse matricielle mais n'ai pas réussi à les utiliser. Genre quelque chose comme ça mais je comprends moyen ces outils:
With Sheets("av")
Set Plageproductnm = .Range(.Cells(2, 9), .Cells(LastLineNm, 9))
Set Plagesubstnm = .Range(.Cells(2, 11), .Cells(LastLineNm, 11))
End With
For LineN = 2 To LastLineN Step 1
Productn = Sheets("n").Cells(LineN, 9)
Substn = Sheets("n").Cells(LineN, 11)
Nbreapparition = 0
Variable1 = "=SUMPRODUCT((Plageproductnm= " & Productn & " )*(Plagesubstnm= " & Substn & " ))"
Variable2 = Evaluate("=sum((Plageproductnm=" & Productn & ")*(Plagesubstnm=" & Substn & "))")
Next LineN
Ensuite je met des conditions selon les valeurs des variables 1 et 2. Enfin bref.

Si quelqu'un pouvait m'aider ce serait génial. Je m'arrache les cheveux là dessus.

Merci à tous ceux qui prendront le temps de m'aider


4 réponses

Réponse 1 / 4
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
17 avril 2014 à 14:21
Bonjour

est ce normal que tu aies Plusieurs fois une nouvelle référence dans le tableau feuille av ?
D9 et F5
0
Jack russel
17 avril 2014 à 14:25
Bonjour Michel, oui c'est fait exprès :) Il peut arriver que des combinaisons se répète, dans la feuille av comme dans la feuille n! Merci de ton aide!
0
Réponse 2 / 4
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
17 avril 2014 à 14:58
Tu as écris
Et si elle est nouvelle il faut pouvoir la réécrire dans une autre feuille encore, afin de créer au final une liste de nouvelles combinaisons.
mais la feuille résultat, je ne devrais t'il pas lire que les 2 nouveles :Z4 et D9 ?

Si c'est une compilation mets ces 2 nouvelles valeurs à la suite "cellule A et derlig+1" au lieu de A2
le code proposé 
Option Explicit
'-----
Sub reperer_nouvelles()
Dim Derlig As Integer, T_av, Idx As Integer, D_av As Object, Ref As String
Dim D_n As Object, T_n
Dim T_new, separe, Cptr As Integer
ReDim T_new(2, 0)

With Sheets("av")
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     Set D_av = CreateObject("scripting.dictionary")
     T_av = .Range("A2:B" & Derlig)
          For Idx = 1 To UBound(T_av)
          Ref = T_av(Idx, 1) & " " & T_av(Idx, 2)
          If Not D_av.exists(Ref) Then D_av.Add Ref, ""
     Next
     T_av = D_av.keys
End With

With Sheets("n")
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     Set D_n = CreateObject("scripting.dictionary")
     T_n = .Range("A2:B" & Derlig)
     For Idx = 1 To UBound(T_n)
          Ref = T_n(Idx, 1) & " " & T_n(Idx, 2)
          If Not D_n.exists(Ref) Then D_n.Add Ref, ""
     Next
End With

For Idx = 0 To UBound(T_av)
     If Not D_n.exists(T_av(Idx)) Then
          separe = Split(T_av(Idx))
          ReDim Preserve T_new(2, Cptr)
          T_new(0, Cptr) = separe(0)
          T_new(2, Cptr) = separe(1)
          Cptr = Cptr + 1
End If
Next

With Sheets("Résultat")
     '.Range("A2:C1000").Clear ' a activer après essais
     .Range("E2").Resize(Cptr, 3) = Application.Transpose(T_new) 'remplacer E2 par A2 après essais
End With

End Sub

La maquette
https://www.cjoint.com/?3DroY0JbbKe
0
Jack russel
17 avril 2014 à 15:32
Merci Michel! Trop fort :) Par contre tu utilises des outils que je ne connais pas... J'essaye d'adapter à mon fichier réel mais ça le fonctionne pas. En fait dans le vrai fichier ceux sont les colonnes 9 et 11 qui m'intéressent.

Les cellules de ces colonnes contiennent des chaines de caractères que j'aimerais extraire entières... En faisant les modif ci dessous ça me découpe le contenu des cellules et ne retire pas les infos désirées.

Option Explicit
'-----
Sub reperer_nouvelles()
Dim Derlig As Integer, T_av, Idx As Integer, D_av As Object, Ref As String
Dim D_n As Object, T_n
Dim T_new, separe, Cptr As Integer
ReDim T_new(2, 0)

With Sheets("av")
Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
Set D_av = CreateObject("scripting.dictionary")
T_av = .Range("A2:B" & Derlig)
For Idx = 1 To UBound(T_av)
Ref = T_av(Idx, 9) & " " & T_av(Idx, 11) 'J'ai remplacé 1 par 9 et 2 par 11
If Not D_av.exists(Ref) Then D_av.Add Ref, ""
Next
T_av = D_av.keys
End With

With Sheets("n")
Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
Set D_n = CreateObject("scripting.dictionary")
T_n = .Range("A2:B" & Derlig)
For Idx = 1 To UBound(T_n)
Ref = T_n(Idx, 9) & " " & T_n(Idx, 11) 'J'ai remplacé 1 par 9 et 2 par 11
If Not D_n.exists(Ref) Then D_n.Add Ref, ""
Next
End With

For Idx = 0 To UBound(T_av)
If Not D_n.exists(T_av(Idx)) Then
separe = Split(T_av(Idx))
ReDim Preserve T_new(2, Cptr)
T_new(0, Cptr) = separe(0)
T_new(2, Cptr) = separe(1)
Cptr = Cptr + 1
End If
Next

With Sheets("Résultat")
.Range("A2:C1000").Clear
.Range("A2").Resize(Cptr, 3) = Application.Transpose(T_new)
End With

Veux tu que je refasse un fichier d'exemple? Je suis désolé, je pensais que celui envoyé aurait suffit mais non :/

Merci encore! Tu me sauves la vie!!!!
0
Jack russel
17 avril 2014 à 16:21
"Tu as écris
Et si elle est nouvelle il faut pouvoir la réécrire dans une autre feuille encore, afin de créer au final une liste de nouvelles combinaisons.
mais la feuille résultat, je ne devrais t'il pas lire que les 2 nouvelles :Z4 et D9 ? "

Non la réécrire une seule fois c'est bon :) On est dans le qualitatif et non le qualitatif :D
0
Réponse 3 / 4
Jack russel
17 avril 2014 à 16:38
J'ai créé un fichier très ressemblant au fichier original (données confidentielles).

http://cjoint.com/?DDrqMhGQUuV
0
Réponse 4 / 4
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 17/04/2014 à 16:51
je lis:

..." J'essaye d'adapter à mon fichier réel mais ça le fonctionne pas. En fait dans le vrai fichier ceux sont les colonnes 9 et 11 qui m'intéressent.

Les cellules de ces colonnes contiennent des chaines de caractères que j'aimerais extraire entières... En faisant les modif ci dessous ça me découpe le contenu des cellules et ne retire pas les infos désirées.3...

BRAVO!

mais POURQUOI les demandeurs envoient presque toujours des fichiers bidon ne correspondant peu ou prou à la réalité ? conclusion, il faut parfois tout recommencer et là c'est le cas

Il faut bien te rendre compte que ce que tu demandes n'est pas forcément facile et que personne ne veut passer parfois plusieurs heures à essayer de résoudre un problème bénévolement pour se voir dire après coup « non vous n'avez pas compris mon problème (rarement, je n'ai pas bien expliqué) il faut en plus que.... »


Décourageant

Michel
0
Jack russel
17 avril 2014 à 16:55
Pour ma part ce fut surement un peu trop de confiance en moi. Je pensais pouvoir adapter mais je suis juste dépassé, comme vous le dites ce sujet est plutôt difficile. Non et puis j'ai surement mal réfléchi mon premier fichier d'exemple...

Désolé de vous avoir fait perdre votre temps.

Et puis vous aviez parfaitement compris le problème que j'ai exposé, c'est juste mon premier fichier qui n'était pas adapté à ma demande.

Encore merci toutefois, je comprendrais que vous arrêtiez de bosser sur ma demande.

Bien cordialement
0

Discussions similaires

"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses
Exemple de base de données access
Abdlahsaki -
Fleptche -

9 réponses
Nettoyer une base de données avec une liste
TOT127 -
TOT127 -

11 réponses
Erreur la zone de données passée à un appel système est insu
Vincent -
Panth33ra -

5 réponses