VBA après une boucle, vérifier les valeurs

[Arpette]

Bonsoir à toutes et tous,
Dans une procédure j'ai une boucle qui me renvoie les valeurs d'une feuille2 vers une feuille 1 en colonne B. Je souhaiterais à la fin de cette boucle, vérifié si la valeur " Ligne non trouvée" est trouvée une seule fois, avoir un message " Merci de renseigner les lignes" et sortir de la procédure. Si la valeur n'est pas trouvée, on poursuit.
Merci de votre aide.
@+

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs (Résolu)

Re, j'ai réussi, voici le code, si il y a plus simple je suis preneur.
Merci à vous
@+

Option Explicit
Sub test()
Dim i As Range
Dim j As Range
Dim k As Range
Dim Départ As String
Dim Bx As Long
Set i = Worksheets("Feuil1").Range("A" & Worksheets("Feuil1").Range("A65536").End(xlUp).Row)
Set j = Worksheets("Feuil2").Range("A" & Worksheets("Feuil2").Range("A65536").End(xlUp).Row)
Do While i.Row > 1
    With Worksheets("Feuil2").Range("A2:A" & Worksheets("Feuil2").Range("A65536").End(xlUp).Row)
        Set j = .Find(i)
        If Not j Is Nothing Then
            Départ = j.Address
            Do
                i(1, 2) = j(1, 2)
            Set j = .FindNext(j)
            Loop While Not j Is Nothing And j.Address <> Départ
            Else
            i(1, 2) = "Ligne non trouvée"
        End If
    End With
Set i = i(0, 1)
Loop

With Worksheets("Feuil1")
Set k = .Range("B2:B65536").Find("Ligne non trouvée", lookat:=xlWhole)
    If Not k Is Nothing Then
        Bx = MsgBox("Merci de vérifié les lignes de production", vbYesNo)
        If (Bx = 6) Then
            Else
            Exit Sub
        End If
    End If
End With
End Sub

 

[julberto]

Re : VBA après une boucle, vérifier les valeurs

Bonjour Arpette,

par exemple, ajouter un flag :

Dim flag As Boolean
flag = False
........


            i(1, 2) = "Ligne non trouvée"
           flag = True
        End If
..............

Loop
If flag Then MsgBox "Merci de renseigner les lignes non renseignées", vbCritical: Exit Sub
End Sub

cordialement

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs

Bonsoir Juleberto, merci pour ton code, il répond bien à ma première demande. Mais en voulant l'adapter à mon fichier initial, je me suis apperçu que j'étais complètement à côté de la plaque. En fait, il faut que je vérifie que toutes les valeur de la feuille 1 colonne A sont présentes présentes dans la feuille2 colonne A. Toute valeur de la feuille 1 non trouvée en feuille 2 doit être ajoutée dans cette dernière et à la fin le message "Merci de renseigner les lignes".
Toutes mes excuses, pour cette erreur.
Merci de votre aide
@+

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs

Rebonsoir, je reformule ma demande, je me suis complètement planté. J'ai réécris mon code mais il doit m'en manquer un bout. J'ai toujours mes 2 feuilles, toute valeur de la feuille 1 n'étant pas présente en feuille 2, je la rajoute sur la feuille 2, sur la dernière ligne. Je vous joints mon nouveau fichier
Merci de votre aide
@+

 

[Etienne2323]

Re : VBA après une boucle, vérifier les valeurs

Salut Arpette,
essayez ceci.

Option Explicit
Sub Test()

Dim F1 As Worksheet, F2 As Worksheet
Dim i As Integer, DL As Integer
Dim c
Dim Valeur_Recherche As String

Application.ScreenUpdating = False

Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
F1.Select
DL = Cells(65536, 1).End(xlUp).Row
For i = 2 To DL
    F1.Select
    Valeur_Recherche = Cells(i, 1).Value
    F2.Select
    Set c = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 2)).Find(Valeur_Recherche, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        GoTo Poursuivre
    Else
        With Cells(Cells(65536, 1).End(xlUp).Row + 1, 1)
            .Value = Valeur_Recherche
            .HorizontalAlignment = xlLeft
        End With
        Cells(Cells(65536, 1).End(xlUp).Row, 2).Value = "Veuillez remplir ce champs avec l'information pertinente. Merci !"
    End If
Poursuivre:
Next i

Set F1 = Nothing
Set F2 = Nothing

End Sub

Cordialement,

Étienne

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs

Merci cousin , c'est exactement ce que je voulais, bonne journée à toi, moi je vais au lit.
Merci encore
@+

 

[Arpette]

Re : VBA dans boucle, vérifier les valeurs améliorer code

Bonsoir à toutes et à tous, Etienne m'a donné un code qui répond à mon souhait, mais quand je l'adapte à mon fichier type qui fait 20000 lignes en feuille 1, c'est un peu long. Peut-on l'améliorer
Merci de votre aide.
@+

 

[Hippolite]

Re : VBA après une boucle, vérifier les valeurs

Bonsoir,
Tu n'arrêtes pas de calculer la dernière ligne de la feuille2.
Tu pourrais remplacer les "Cells(65536, 1).End(xlUp).Row" par un compteur qui s'incrémente
quand "c Is Nothing"
On peut également simplifier l'écriture de la dernière boucle.
Ce qui devrait donner quelque chose comme :

Option Explicit
Sub Test()

Dim F1 As Worksheet, F2 As Worksheet
Dim i As Integer, DL As Integer, j as Integer
Dim c
Dim Valeur_Recherche As String

Application.ScreenUpdating = False

Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
F1.Select
DL = Cells(65536, 1).End(xlUp).Row
F2.Select
j = Cells(65536, 1).End(xlUp).Row
For i = 2 To DL
    F1.Select
    Valeur_Recherche = Cells(i, 1).Value
    F2.Select
    Set c = Range(Cells(2, 1), Cells(j, 2)).Find(Valeur_Recherche, LookIn:=xlValues, Lookat:=xlWhole)
    If c Is Nothing Then
        With Cells(j + 1, 1)
            .Value = Valeur_Recherche
            .HorizontalAlignment = xlLeft
        End With
        Cells(j + 1, 2).Value = "Veuillez remplir ce champs avec l'information pertinente. Merci !"
		j = j + 1
    End If
Next i

Set F1 = Nothing
Set F2 = Nothing
Application.ScreenUpdating = True
End Sub

Non testé, je n'ai pas excel sous la main.
A+

Edit :
- testé, ça marche
- complété par le post 11 avec ta dernière version de macro que je n'avais pas pu lire

 

[Fo_rum]

Re : VBA après une boucle, vérifier les valeurs

Bonsoir,

l'utilisation de tableaux permet d'augmenter grandement la vitesse des macros.
Vois si cela convient (pas trop compris l'utilité du message).

 

[Hippolite]

Re : VBA après une boucle, vérifier les valeurs

Bonjour,
En complément du post 9, pour ta dernière version de macro que je n'avais pas pu lire :

Option Explicit
Sub Test()
Dim Bx As Long
Dim F1 As Worksheet, F2 As Worksheet
Dim i As Integer, DLF1 As Integer, DLF2 As Integer
Dim c
Dim Valeur_Recherche As String
Dim flag As Boolean
Application.ScreenUpdating = False
flag = False

Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
F1.Select
DLF1 = Cells(65536, 1).End(xlUp).Row
F2.Select
DLF2 = Cells(65536, 1).End(xlUp).Row
For i = 2 To DLF1
    F1.Select
    Valeur_Recherche = Cells(i, 1).Value
    F2.Select
    Set c = Range(Cells(2, 1), Cells(DLF2, 2)).Find(Valeur_Recherche, LookIn:=xlValues, Lookat:=xlWhole)
    If c Is Nothing Then
        With Cells(DLF2 + 1, 1)
            .Value = Valeur_Recherche
            .HorizontalAlignment = xlLeft
        End With
        Cells(DLF2 + 1, 2).Value = "Ligne non trouvée"
        DLF2 = DLF2 + 1
        flag = True
    End If
Next i
If flag Then Bx = MsgBox("Merci de vérifié les lignes de production", vbYesNo)
        If (Bx = 6) Then
            Else
            Exit Sub
        End If
Set F1 = Nothing
Set F2 = Nothing
Application.ScreenUpdating = True
End Sub

 

[Efgé]

Re : VBA après une boucle, vérifier les valeurs

Bonjour Arpette, Hippolite , Fo_rum , Etienne2323, julberto,
Comme je n'ai pas compris la même chose que Fo_rum, je fais une proposition qui devrait être assez rapide à l'éxecution:
[

Sub Test_2()
Dim Dico As Object, Dico2 As Object, I&, J&, Plg(), Plg2()
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
    Plg = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
End With
With Sheets("Feuil2")
    Plg2 = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
    For I = LBound(Plg2, 1) To UBound(Plg2, 1)
        Dico(Plg2(I, 1)) = Plg2(I, 1)
    Next I
    For J = LBound(Plg, 1) To UBound(Plg, 1)
        If Not Dico.Exists(Plg(J, 1)) Then Dico2(Plg(J, 1)) = "Absent de la liste"
    Next J
    If Dico2.Count > 0 Then
        .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(Dico2.Count, 1) = Application.Transpose(Dico2.Keys)
        .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(Dico2.Count, 1) = Application.Transpose(Dico2.Items)
        MsgBox "Veuillez remplir ce champs avec l'information pertinente. Merci !"
    Else
        MsgBox "Pas de référence absente"
    End If
End With
End Sub

Cordialement

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs

Bonsoir Hippolite , Fo_rum , Etienne2323, julberto, Efgé et merci pour tous ces codes.
J'ai retenu deux codes, celui d'Hippolite auquel j'associe Etienne, Julberto et Fo_rum que je pense avoir mis sur une mauvaise piste lors de mon premier post et celui de Efgé qui également est parti sur cette mauvaise orientation de ma part.
Je vous joints mon fichier avec les 2 codes, en Module1 celui d'Hippolite qui renvoi un résultat exact et celui d'Efge en module 2 beaucoup plus rapide mais résultat inexact, qui je pense est du à mon premier post.
Merci de votre aide.
@+

 

[Efgé]

Re : VBA après une boucle, vérifier les valeurs

Re
Je ne vois pas la différence dans les résultats. Il faudrait peut être choisir un format pour tes cellules (parfois texte, parfois nombre). Mets tout en texte ou tout en nombre et le résultat est identique pour les deux macros présentent dans ton dernier fichier.
Cordialement

 

[Arpette]

Re : VBA après une boucle, vérifier les valeurs

Bonsoir Efge, si tu lances le module 1, dans la feuil2 tu as la valeur 6628 qui n'a pas été trouvée en Feuil1 et si tu lances le module 2, tu as 6516, 6628, 6630 qui n'ont pas été trouvés, alors que seul 6628 n'existe pas en feuil1.
Merci ton aide, car ton code est très rapide, mais il y a une erreur qui vient peut-être de mon explication.
@+