Macro pour comparaison

Version imprimable

29/07/2016, 11h09
bones24

1 pièce(s) jointe(s)

Macro pour comparaison

Pièce jointe 216740
]Bonjour,

Je souhaiterais faire une macro qui compare deux listes situées dans deux feuilles différentes :
- liste1 feuille 1 de la première ligne remplie à la dernière
- liste2 feuille 2 idem
- si le nom se trouve dans le listes 1 et 2, le réécrire dans la colonne B feuille 1, sinon mettre NP .
exemple en fichier joint

Merci d'avance
29/07/2016, 14h08
jerome.vaussenat

Salut,

Si tu veux vraiment du VBA pourquoi pas. Sinon on peut le faire avec une "simple" formule.

Code:

=SIERREUR(RECHERCHEV(A2;Feuil2!A:A;1;FAUX);"NP")

Merci de dire si çà te va.
29/07/2016, 14h29
bones24

merci

Merci
j'ai traité tout mon fichier avec des formules Et ç amarche. mais comme l'homme n'est jamais satisfait, il me demande de tout reprendre en VBA
29/07/2016, 16h14
jerome.vaussenat

Re,

Dans la feuil2 que tu nous as fournis, il y a des trous.
Dans la version complète, c'est le cas ?
Si oui, combien peux tu avoir de ligne max ?

Cela permettra de fixer les limites de la boucle de parcourt de cette feuille.

ps : Je précise tout de même que dans ton cas, le vba c'est utiliser le canon pour tuer une mouche ...:ptdr:
30/07/2016, 09h24
bones24

yep

Je suis d'accord avec toi , une bien petite mouche.
les lignes ne sont pas vides. la limite peux etre fichee à 1000
Merci

Bonjour,

Essaie comme cela :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Comparer()
Dim Cel As Range
    With Worksheets("Feuil1")
        For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            If Application.CountIf(Worksheets("Feuil2").Columns(1), Cel.Value) > 0 Then
                Cel.Offset(, 1) = Cel.Value
            Else
                Cel.Offset(, 1) = "NP"
            End If
        Next Cel
    End With
End Sub

Cordialement.

Bonjour,
Pour être franc avec vous, même en vba je gèrerai ça avec une formule plutôt qu'une boucle!

Code:

1
2
3
4
5
6
With Worksheets("Feuil1")
    With .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
             .formular1c1="=maformule"
              .value=.value
    End With
End With

Bonjour,
perso, si beaucoup de données, je passe par des tableaux mais Robert à peut-être raison (pas testé en terme de rapidité)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Comparer()
Dim DCel As Range, TbL1, TbL2, Resultat()
Dim x As Long, y As Long
  With Worksheets("Feuil1")
    Set DCel = .Range("A" & .Rows.Count).End(xlUp)
    TbL1 = .Range("A2", DCel)
    ReDim Resultat(1 To UBound(TbL1, 1))
    With Worksheets("Feuil2")
      Set DCel = .Range("A" & .Rows.Count).End(xlUp)
      TbL2 = .Range("A2", DCel)
    End With
    For x = 1 To UBound(TbL1, 1)
      For y = 1 To UBound(TbL2, 1)
        If TbL1(x, 1) = TbL2(y, 1) Then
          Resultat(x) = TbL2(y, 1)
          Exit For
        Else
          Resultat(x) = "NP"
        End If
      Next y
    Next x
    .Range("B2").Resize(UBound(TbL1, 1)) = Application.Transpose(Resultat)
  End With
End Sub

02/08/2016, 11h39
bones24

RESOLU

MERCI à vous j'ai résolu le probléme
bonne journée