Discussion :

[gilles06]

Bonjour a tous,

Voila j'ai un petit probleme, et je ne sais pas comment le resoudre.
J'extracte des donnees tous les mois dans une feuille excel (base de donnes) et ces donnes sont variables d'un mois a l'autre. Le nombre de collumns est fixe 10, par contre le nombre de lignes est variable (entre 8000 et 11000) et certaines lignes peuvent etre identique par contre d'autres sont nouvelles ou bien ont disparues. Je me sers de cette feuille comme base de travail pour un TCD (tableau croise dynamique).
Mon probleme est : Comment trouver (le plus rapidement) les differences (sur 1 seule collonne) sur la nouvelle feuille.
Voir mon exemple Feuille "New" est la derniere extraction de donnes et feuille "Old" est l'ancienne.
Je veux comparer la collonne 4 de 2 feuilles en ecrivant en collonne 5 "Diff" si la collonne 4 a ete changee ou New si la ligne est nouvelle

Merci de votre aide.

[melouille56]

Hello

Peux pas télécharger ton fichier car je suis o boulot mais une question quand même : Est-ce que tu peux trier ton ancienne feuille et ta nouvelle ou il faut les laisser dans l'ordre qu'elles ont ? Ca peut aider a simplifier la macro s'il faut qu'elle parcoure toutes les lignes.

Mél

[ouskel'n'or]

Je n'ai pas de réponse miracle pour régler ton problème :
Parcourir la nouvelle feuille et pour chaque nom vérifier son existence dans l'ancienne feuille.
Une boucle sur les cellules de la colonne de ta nouvelle feuille avec For each / Next, et une recherche de chaque donnée avec Find sur l'ancienne feuille
Ne pas utiliser d'Activate, Select ou autre selection de feuille ou de cellule et Placer Application.ScreenUpdating = False sur la première ligne de ta procédure (que tu repasseras à True en fin de sub)
Si une syntaxe te manque, tu dis.
A+

[gilles06]

Merci a vous,

En fait je simplifie le travail en faiusant deja des tris, mais par contre je n'arrive pas a faire une recherche sur une ligne complete (sur un range) avec la fonction .Find. J'ecris ceci et ca ne marche pas et je ne sais pas pourquoi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
row=1
Do
    c2.Activate
    Search = Range("B" & Row & ":" & "F" & Row).Value
 
    c1.Activate
    With c1.Range(Cells(2, 2), Cells(lastLineExtract, 6))
     Set c = .Find(Search, LookIn:=xlValues, LookAt:=xlWhole)
     If Not c Is Nothing Then
                            PValue = c.Address
                            c2.Activate
                            Cells(Row, LastColExtract + 1) = PValue
                         Else
                            c2.Activate
                            Cells(Row, LastColExtract + 1) = Cells(Row, ColAlloc)
     End If
    End With
 Row = Row + 1
Loop Until Row = lastLineExtract

Si qq peux m'aider a trouver comment faire une recherche sur une ligne complete se serait ma solution

Merci

[ouskel'n'or]

Je t'ai fait quelque chose sans être certain de connaître tous les cas de figures. Essaie de t'en inspirer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub test()
Dim FL1 As Worksheet 'nouvelle feuille
Dim FL2 As Worksheet 'ancienne feuille
Dim Cell As Range 'Cellules parcourues dans "Last"
Dim c As Range 'Donnée trouvée ou non dans "Old"
Dim DerLig1 As Long, DerLig2 As Long 'respectivement, dernière ligne renseignée de FL1 et FL2
    Set FL1 = Worksheets("New")
    Set FL2 = Worksheets("Last")
    DerLig1 = FL1.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    DerLig2 = FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    For Each Cell In FL1.Range("A2:A" & DerLig1)
        With FL2.Range("A2:A" & DerLig2)
            Set c = .Find(Cell, LookIn:=xlValues, LookAt:=xlWhole)
            If c Is Nothing Then
                FL1.Cells(Cell.Row, 6).Value = "new"
            ElseIf Not c Is Nothing Then
                If Cell.Offset(0, 4).Value <> c.Offset(0, 4).Value Then
                    FL1.Cells(Cell.Row, 6).Value = "diff"
                    ElseIf Cell.Offset(-1, 0) = Cell And Cell.Offset(0, 4) = Cell.Offset(-1, 4) Then
                    FL1.Cells(Cell.Row, 6).Value = "new"
                End If
            End If
        End With
        Set c = Nothing
    Next
    Set FL1 = Nothing
    Set FL2 = Nothing
    Set c = Nothing
End Sub

Sur les données fournies, ce code fonctionne après tri des données comme tu l'as fait.
Tu dis
A+

[gilles06]

C'est tres sympa et j'ai fait qq chose de similaire qui a l'air de fonctionner, mais par contre est tres tres long car le fichier est > 10000 lignes avec 10 collonnes.
C'est pourquoi je voulais savoir s'il etait possible d'utiliser la focntion .find sur un range de cells est que la fonction puisse me dire rapidement si la ligne existe ou pas.
J'ai bien essaye mais sans succes.

Si qq a une idee

Merci

[ouskel'n'or]

Tu peux utiliser la recherche dichotomique qui réduit de manière appréciable le temps de recherche. Regarde ici, je pense que tu pourras trouver ton bonheur, tu as plusieurs solutions dont une avec une fonction Excel.
A+

[patbou]

pour accelerer ton code tu peux passer par des variants ou des tableaux

http://silkyroad.developpez.com/vba/tableaux/

[gilles06]

Merci a tous,

J'avais resolu mon probleme avec des boucles imbriquees en m'inspirant de l'exemple de ouskln'nor mais j'avais des temps de reponse extrement long et donc pas possible. Aussi j'ai trouve une autre solution en faisant un mixt et maintenant en 2 mn je met a jour mon tableau de 10000 lignes et 9 collonnes.
Voici mon implementation si ca peux aider qq et si on peut faire mieux se serait super :
Pour resumer, je met sers de la fonction .Find (extrement puissante et rapide) en boucles impriquees.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
    For Each Cell In FL1.Range("B2:B" & DerLig1)
        With FL2.Range("B2:B" & DerLig2)
            Set n = .Find(Cell, LookIn:=xlValues, LookAt:=xlWhole)
            If n Is Nothing Then
              FL1.Cells(Cell.Row, DerCol1 + 1).Value = "new name"
               Else
               firstaddress = n.Address
               NameAddr = Mid(firstaddress, 4, 7) - 1
               With FL2.Range("C" & NameAddr & ":C" & DerLig2)
               Set p = .Find((Cell.Offset(0, 1).Value), LookIn:=xlValues, LookAt:=xlWhole)
               If p Is Nothing Then
                  FL1.Cells(Cell.Row, DerCol1 + 1).Value = "new proj"
                    Else
                     secondaddress = p.Address
                     ProjAddr = Mid(secondaddress, 4, 7) - 1
                     With FL2.Range("F" & ProjAddr & ":F" & DerLig2)
                      Set m = .Find((Cell.Offset(0, 4).Value), LookIn:=xlValues, LookAt:=xlWhole)
                      If m Is Nothing Then
                      FL1.Cells(Cell.Row, DerCol1 + 1).Value = "new month"
                      Else
                      If Cell.Offset(0, 4).Value = m.Offset(0, 0).Value Then
                      FL1.Cells(Cell.Row, DerCol1 + 1).Value = m.Offset(0, 1).Value
                        Else
                          MonthAddr = m.Address
                            Do
                              Set m = .FindNext(m)
                      If (Cell.Offset(0, 1).Value = p.Offset(0, 0).Value) And (Cell.Offset(0, 4).Value = m.Offset(0, 0).Value) Then
                     FL1.Cells(Cell.Row, DerCol1 + 1).Value = m.Offset(0, 0).Value
                             Exit Do
                           End If
                 Loop While Not (m Is Nothing And m.Address <> MonthAddr)
                                                                           endloop = False
                                                                        End If
                                                       End If
                                                      End With
                                     End If
                                End With
            End If
        End With
        Set m = Nothing
        Set n = Nothing
        Set p = Nothing
    Next