Comparaison automatique de 2 feuilles

[koewin]

bonjour,

J'ai un tableau avec 4 feuilles :

• un inventaire a un jour donné (Inventaire)
• une liste de matériel normalement présent (Matériel)
• les non pointés (non pointé)
• les manquants (A renseigner)

J'aimerai comparer les chiffres correspondants au code barre de mes matériels dans les 2 première feuilles (Inventaire et Materiel).

Si le code barre est présent dans les 2 -> ne rien faire
Si CB présent dans Inventaire et pas dans Matériel -> copier infos dans "A renseigner"
Si CB présent dans Matériel et pas dans Inventaire -> copier infos dans "non pointé"

Qui pourrait m'aider à faire un petit bouton sur la 1ère feuille qui me fait tout ça automatiquement ?

Je vous joins un fichier exemple de ce que je voudrais à la fin.

Merci d'avance.de votre aide.

Cdt.

koewin

 

[david84]

Re : Comparaison automatique de 2 feuilles

Bonjour,
ci-joint une proposition par formule.
A noter que ton exemple comporte des erreurs.
Cordialement

 

[pierrejean]

Re : Comparaison automatique de 2 feuilles

bonjour koewin

Vois si cela te convient

Edit : Salut david

 

[Bebere]

Re : Comparaison automatique de 2 feuilles

bonjour koewin
à chaque clic sur commanbutton1 les feuilles à renseigner et non pointé sont effacées
ensuite update
à bientôt

 

[tototiti2008]

Re : Comparaison automatique de 2 feuilles

Bonjour à tous,

à la bourre, moi

un essai quand même

 

[koewin]

Re : Comparaison automatique de 2 feuilles

Bonjour,

Encore une fois, pas déçu par la réactivité du forum.

Je teste tout ça et je vous tiens au courant.

Juste un point pour Bebere (c'est celui que je teste), est-ce possible de rajouter un bouton qui vide les feuilles "Non pointé" et "A renseigner" plutot que de le mettre directement dans la commande de comparaison.

Afin d'être sûr visuellement que les feuilles sont vides avant de lancer le test.

En tout cas merci à tous.

Cdt.

koewin

 

[Efgé]

Re : Comparaison automatique de 2 feuilles

Bonjour à tous,
Bien après le déluge encore une foi, mais je l'ai fait, je le poste....
Sur un code de Boisgontier.
Cordialement

 

[Fo_rum]

Re : Comparaison automatique de 2 feuilles

Salut

plus on est de fous, plus on rit !
2 propositions (formules avec 2 feuilles, VBA avec 4 feuilles)

 

[Bebere]

Re : Comparaison automatique de 2 feuilles

bonjour PierreJean,Forum,Efgé,Tototiti,David
quel déluge,j'espère que notre ami sait nager
changements effectués
à bientôt

 

[tototiti2008]

Re : Comparaison automatique de 2 feuilles

Bonjour à tous

7 versions, si j'ai bien compté
Bon, ça devrait mettre koewin sur la voie

 

[pierrejean]

Re : Comparaison automatique de 2 feuilles

Re

@ Efgé

Je connais bien BOISGONTIER et je doute qu'il avalise ta proposition
Un petit essai rapide montre qu'elle très lente

A titre d'essai voici les temps relevés chez moi avec
161 lignes d'inventaire
145 lignes de Materiel
Bebere: 0.0625
Tototiti: 0.0625
Efgé: 1.8125
pierrejean: 0.03125

 

[Efgé]

Re : Comparaison automatique de 2 feuilles

Re à tous, Bonjour pierrejean,
Je ne conteste en rien le fait que ma proposition puisse-t-être plus longue que d'autres.
Je n'ai fait référence à Boisgontier que par principe puisque je suis largement parti d'un de ses exemples (que l'on peut trouver sur son site).
Je met le code de départ:

Sub DiffBD1BD2()
  ligneEcrit = 2
  nblignes = Sheets("BD1").[A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = Sheets("BD1").Cells(i, 1)
    If IsError(Application.Match(x, Sheets("BD2").[A2:A1000], 0)) Then
       Cells(ligneEcrit, 1) = x
       ligneEcrit = ligneEcrit + 1
     End If
   Next i
  '---
  ligneEcrit = 2
  nblignes = Sheets("BD2").[A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = Sheets("BD2").Cells(i, 1)
    If IsError(Application.Match(x, Sheets("BD1").[A2:A1000], 0)) Then
      Cells(ligneEcrit, 2) = x
      ligneEcrit = ligneEcrit + 1
    End If
  Next i
End Sub

à comparer (on compare beaucoup sur ce fil ) avec ma version :

Private Sub CommandButton1_Click()
Sheets("A renseigner").Range("A2:AA1000").ClearContents
Sheets("Non pointé").Range("A2:AA1000").ClearContents
'Boisgontier
ligneEcrit = 2
With Sheets("Inventaire")
  nblignes = .[A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = .Cells(i, 1)
    If IsError(Application.Match(x, Sheets("Materiel").[A2:A1000], 0)) Then
       .Cells(i, 1).EntireRow.Copy
       Sheets("A renseigner").Cells(ligneEcrit, 1).Insert Shift:=xlDown
       ligneEcrit = ligneEcrit + 1
     End If
   Next i
End With
  '---
  ligneEcrit = 2
With Sheets("Materiel")
  nblignes = [A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = .Cells(i, 1)
 
    If IsError(Application.Match(x, Sheets("Inventaire").[A2:A1000], 0)) Then
        .Cells(i, 1).EntireRow.Copy
        Sheets("Non pointé").Cells(ligneEcrit, 1).Insert Shift:=xlDown
        ligneEcrit = ligneEcrit + 1
    End If
  Next i
End With
Application.CutCopyMode = False
MsgBox "Traitement terminé"
End Sub

En espérant avoir "justifié" mon post, qui sommes toutes, n'est qu'un septième du fil .
Cordialement

 

[Ubot303]

Re : Comparaison automatique de 2 feuilles

Bonjour à tous
Est-ce qu'une version de vos réponses déploie le magnifique outil des mises en formes conditionnelles?
Ou j'en rajoute une?

 

[pierrejean]

Re : Comparaison automatique de 2 feuilles

Re

justifié !!
je ne crois pas
Meme si l'ecart visuel est faible , il y a une vraie perversion du code

Voila une version plus credible

Private Sub CommandButton1_Click()
debut = Timer
Sheets("A renseigner").Range("A2:[COLOR=blue]C65536[/COLOR]").ClearContents
Sheets("Non pointé").Range("A2:[COLOR=blue]C65536[/COLOR]").ClearContents
'Boisgontier
ligneEcrit = 2
With Sheets("Inventaire")
  nblignes = .[A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = .Cells(i, 1)
    If IsError(Application.Match(x, Sheets("Materiel").[A2:A1000], 0)) Then
      [COLOR=red] '.Cells(i, 1).EntireRow.Copy[/COLOR]
[COLOR=red]      'Sheets("A renseigner").Cells(ligneEcrit, 1).Insert Shift:=xlDown[/COLOR]
       [COLOR=blue]Sheets("A renseigner").Cells(ligneEcrit, 1) = x[/COLOR]
[COLOR=blue]      Sheets("A renseigner").Cells(ligneEcrit, 2) = .Cells(i, 2)[/COLOR]
[COLOR=blue]      Sheets("A renseigner").Cells(ligneEcrit, 3) = .Cells(i, 3)[/COLOR]
       ligneEcrit = ligneEcrit + 1
     End If
   Next i
End With
  '---
  ligneEcrit = 2
With Sheets("Materiel")
  nblignes = [A65000].End(xlUp).Row + 1
  For i = 2 To nblignes
    x = .Cells(i, 1)
    If IsError(Application.Match(x, Sheets("Inventaire").[A2:A1000], 0)) Then
        [COLOR=red]'.Cells(i, 1).EntireRow.Copy[/COLOR]
[COLOR=red]       'Sheets("Non pointé").Cells(ligneEcrit, 1).Insert Shift:=xlDown[/COLOR]
       [COLOR=blue]Sheets("Non pointé").Cells(ligneEcrit, 1) = x[/COLOR]
[COLOR=blue]      Sheets("Non pointé").Cells(ligneEcrit, 2) = .Cells(i, 2)[/COLOR]
[COLOR=blue]      Sheets("Non pointé").Cells(ligneEcrit, 3) = .Cells(i, 3)[/COLOR]
        ligneEcrit = ligneEcrit + 1
    End If
  Next i
End With
Application.CutCopyMode = False
MsgBox (Timer - debut & "  Traitement terminé")
End Sub

Edit: @ Ubot303
Bien sur
Tout est bon ici pour apprendre

 

[tototiti2008]

Re : Comparaison automatique de 2 feuilles

Bonjour à tous,
Re,

Allons, PierreJean, le code d'Efgé a tout de même le mérite de fonctionner, et il est tentant de copier toute la ligne plutôt que de lire chaque valeur

Bon, l'insertion de ligne est de trop, je suis d'accord, un coller aurait largement suffit

Je pense que la référence à BOISGONTIER a froissé PierreJean, mais d'un autre côté, nous sommes si nombreux à nous inspirer de codes d'autres personnes sans les citer...