Discussion :

[assiec]

Bonjour à tous,

J'ai trouvé quelques morceaux de codes sur le site mais rien qui ne m'aide vraiment ou qui réalise ce que je veux.

Dans 2 feuilles excel, les tableaux font 17 colonnes et 17000 lignes environs.

La premiere valeur a comparer est en A7.

Il faudrait que la macro compare la colonne A des 2 feuilles.

Ex: Si A7 de la feuille 1 est egale a une des cellules de la colonne A de la feuille 2 alors dans la colonne R de la feuille 1 insérer "ok" sinon "pas ok"
ainsi de suite si A8.......jusqu'a la fin de la colonne.

Faire de meme avec la feuille 2.

Merci.

[ouskel'n'or]

Tu as un exxcccélent exemple dans l'aide en ligne à Find.
Si tu as un problème pour l'adapter, tu ramènes ton code, on pourra t'aider
A+

[steelk]

J'ai essayé ca pour toi mais ca marche moyen:

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
 
Sub comparaison()
  Dim F1 As Worksheet, F2 As Worksheet
  Dim chaine As Variant
  Dim Boucle1 As Integer, boucle2 As Integer
 
  'Selection des feuille à utiliser
  Set F1 = Worksheets("Feuil1")
  Set F2 = Worksheets("Feuil2")
 
  'on boucle sur les chaines de la 1er feuille colonne 1 à partir de la ligne 2
  For Boucle1 = 2 To F1.Cells(Rows.Count, 1).End(xlUp).Row
    'convertir la chaine en tableau
    chaine = Split(F1.Cells(Boucle1, 1), " ")
    'parcourir le tableau
    For boucle2 = 0 To UBound(chaine)
      'si la valeur dans le tableau n'est pas dans la chaine de la feuille 2
      If Not InStr(F2.Cells(Boucle1, 1), chaine(boucle2)) > 0 Then
      'on ecrit dans la colonne 18 la valeur manquante
      F2.Cells(Boucle1, 18) = F2.Cells(Boucle1, 18) & chaine(boucle2) & " "
      End If
    Next
 
  'Au besoin on vérifie dans l'autre sens
 
    'convertir la chaine en tableau
    chaine = Split(F2.Cells(Boucle1, 1), " ")
    'parcourir le tableau
    For boucle2 = 0 To UBound(chaine)
      'si la valeur dans le tableau n'est pas dans la chaine de la feuille 1
      If Not InStr(F1.Cells(Boucle1, 1), chaine(boucle2)) > 0 Then
      'on ecrit dans la colonne 18 la valeur manquante
      F1.Cells(Boucle1, 18) = F1.Cells(Boucle1, 18) & chaine(boucle2) & " "
      End If
    Next
   Next
End Sub

Il doit manquer des choses

[ouskel'n'or]

Si A7 de la feuille 1 est egale a une des cellules de la colonne A de la feuille 2 alors dans la colonne R de la feuille 1 insérer "ok" sinon "pas ok"
ainsi de suite si A8

Avec find, ça marche plus mieux
En instanciant tes deux feuilles pour alléger le code

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
Sub Cherche()
Dim FL1 as worksheet
Dim FL2 as worksheet
    Set FL1 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL2 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 to FL1.range("65535").end(xlup).row
        With FL2.Range("a1:a" & FL2.range("65535").end(xlup).row) 'tu désignes ta plage de recherche
            Set c = .Find(Donnee, lookin:=xlValues)
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 18) = "ok"
              else
                FL1.Cells(NoLig, 18) = "/ok"
            End If
        End With
    Next
End sub

Tu peux tester pour moi ?

[assiec]

ouskel'n'or -> Erreur Croix blanche sur fond rouge puis "400"

Steelk-> Ca marche pas car il gere pas le décalage

ex:
feuil1

a
b
c
d

feuil2

a
c
d

en sortie on a sur feuil1:
b
c

et sur feuil2:
c
d

alors qu'il faudrait indiquer que b sur feuil2

[ouskel'n'or]

J'ai apporté une correction immédiatement après avoir posté. Tu vérifies le code.
Vérifie aussi le nom de tes feuilles
A+

[ouskel'n'or]

J'ai oublié deux choses
Déclare c as range dans les déclarations
et dans ces lignes, ajoute Set c = NoThing

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub ........
Dim c as range
Dim FL1.....
            '....
            '.....
 
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 18) = "ok"
              else
                FL1.Cells(NoLig, 18) = "/ok"
            End If
            Set c = NoThing

Promis, je le ferai plus

[assiec]

La methode 'Range' de l'objet '_Worksheet' a échoué

[ouskel'n'or]

j'ai oublié le "A65536"

Code :

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

        With FL2.Range("a1:a" & FL2.range("A65535").end(xlup).row) 'tu désignes ta plage de recherche

Tu dis, sinon je vais devoir trouver un test
Ajoute-le partout où tu as 65535

[steelk]

C'est bon, la modif fonctionne. Par contre ca ne donne pas le resultat attendu.

Voir Pj.

[ouskel'n'or]

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
Sub Cherche()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim c As Range, Donnee as string

    Set FL1 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL2 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 To FL1.Range("A65535").End(xlUp).Row
        donnee = FL1.Cells(NoLig, 1)  'ajouté
        With FL2.Range("a1:a" & FL2.Range("A65535").End(xlUp).Row) 'tu désignes ta plage de recherche
            Set c = .Find(donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 3) = "ok"
              Else
                FL1.Cells(NoLig, 3) = "/ok"
            End If
            Set c = Nothing
        End With
    Next
End Sub

Si on ne cherche rien, bien sûr !
Corrigé. Essaie de comprendre le code
Bonne soirée

[Abed_H]

Bonsoir
ca devrais de convenir peut être

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Findocc()
Dim i As Integer
For i = 7 To Sheets("feuil1").Range("A65536").End(xlUp).Row
  On Error Resume Next
  Set occ = Range("A" & Application.Match(Sheets("feuil1").Range( _
              "A" & i), Sheets("feuil2").Range("A:A"), 0))
       If Not occ Is Nothing Then occ = "ok"
          Sheets("feuil1").Cells(i, 3) = occ
    Set occ = Nothing
Next
End Sub

Bonne soirée.

[assiec]

Bonjour à tous,

Vous etes des dieux les gars....Décidément c'est pas pour moi le code...

Sinon dernière requete, pour appliquer la meme chose à la feuille 2?

J'esssaye des choses mais si vous avez des pistes?

Merci encore.

assiec

J'aimerais également que après avoir identifié si c'est 'ok' ou '/ok', ca me copie dans la colonne 16 de la feuille 2 le contenu en relation (de la cellule en A) de la colonne 16 de la feuille 1 en relation.

C'est possible?

[steelk]

Sinon dernière requete, pour appliquer la meme chose à la feuille 2?

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
Sub Cherche()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim c As Range, Donnee As String
 
    Set FL1 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL2 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 To FL1.Range("A65535").End(xlUp).Row
        Donnee = FL1.Cells(NoLig, 1)  'ajouté
        With FL2.Range("a1:a" & FL2.Range("A65535").End(xlUp).Row) 'tu désignes ta plage de recherche
            Set c = .Find(Donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 18) = "ok"
              Else
                FL1.Cells(NoLig, 18) = "/ok"
            End If
            Set c = Nothing
        End With
    Next
 
   Set FL2 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL1 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 To FL2.Range("A65535").End(xlUp).Row
        Donnee = FL2.Cells(NoLig, 1)  'ajouté
        With FL1.Range("a1:a" & FL1.Range("A65535").End(xlUp).Row) 'tu désignes ta plage de recherche
            Set c = .Find(Donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 18) = "ok"
              Else
                FL1.Cells(NoLig, 18) = "/ok"
            End If
            Set c = Nothing
        End With
    Next
 
 
End Sub

[assiec]

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
Sub Cherche()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim c As Range, Donnee As String
 
    Set FL1 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL2 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 To FL1.Range("A65535").End(xlUp).Row
        Donnee = FL1.Cells(NoLig, 1)  'ajouté
        With FL2.Range("a1:a" & FL2.Range("A65535").End(xlUp).Row) 'tu désignes ta plage de recherche
            Set c = .Find(Donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                FL1.Cells(NoLig, 19) = "ok"
              Else
                FL1.Cells(NoLig, 19) = "/ok"
            End If
            Set c = Nothing
        End With
    Next
 
   Set FL1 = Worksheets("feuil1") 'Le fichier où tu colles
    Set FL2 = Worksheets("feuil2") 'Le fichier où tu cherches
    For NoLig = 7 To FL2.Range("A65535").End(xlUp).Row
        Donnee = FL2.Cells(NoLig, 1)  'ajouté
        With FL1.Range("a1:a" & FL1.Range("A65535").End(xlUp).Row) 'tu désignes ta plage de recherche
            Set c = .Find(Donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                FL2.Cells(NoLig, 19) = "ok"
              Else
                FL2.Cells(NoLig, 19) = "/ok"
            End If
            Set c = Nothing
        End With
    Next
 
End Sub

Ca c'est le bon code.

par contre qqn pour m'aider SVP car c'est assez urgent:

J'aimerais également que après avoir identifié si c'est 'ok' ou '/ok', ca me copie dans la colonne 16 de la feuille 2 le contenu en relation (de la cellule en A) de la colonne 16 de la feuille 1 .

[steelk]

Moi ce qui m'interresse c'est de savoir si à un moment donné, comment peut on connaitre numero de la cellule ou il a trouvé la valeur sur la feuille 2?

[ouskel'n'or]

@ Assiec

Code :

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

1
2
3
4
5
6
            If Not c Is Nothing Then
                FL2.Cells(c.row, 16) = FL1.Cells(NoLig, 16)
                FL2.Cells(NoLig, 19) = "ok"
              Else
                FL2.Cells(NoLig, 19) = "/ok"
            End If

@ steelk

Code :

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

            If Not c Is Nothing Then NoLigneTrouvée = c.row

Bonne soirée

[assiec]

Merci à tous ca fonctionne... en rajoutant:

Code :

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

1
2
3
4
5
6
7
Set c = .Find(Donnee, LookIn:=xlValues)
            If Not c Is Nothing Then
                NoLigneTrouvée = c.Row
                FL1.Cells(NoLig, 5) = "ok"
                FL2.Cells(NoLigneTrouvée, 3) = FL1.Cells(NoLig, 3)
              Else
                FL1.Cells(NoLig, 5) = "/ok"