VBA: recherche et remplacement de lignes dans un tableau

A

Anthony53

XLDnaute Nouveau
Salut tout le monde,

Je suis en train de faire une macro et j'aimerai y ajouter des fonctionnalités pour parer à d'éventuelles erreurs.
J'ai un fichier qui sert à faire des contrôles sur des matières premières. Dans ce fichier un onglet permet de collecter tous les résultats présents dans les différentes feuilles en une seule ligne. A la fin d'un contrôle, les résultats contenus dans cette ligne sont copiés et collés dans une nouvelle ligne d'un autre fichier (nommé synthèse) via une macro associée à un bouton "validation des résultats" (code dans le module 4). Mon souci est que lorsqu'une erreur est effectuée sur un contrôle et que celui ci a été validé, des correction peuvent être faites mais lorsqu'on valide à nouveau, une nouvelle ligne est ajoutée dans le fichier synthèse alors que l'idéal serai que la ligne erronée soit remplacée. Et c'est là où je bloque dans le code et que j'ai besoin de votre aide.

J'ai laissé pas mal de commentaires dans mes fichiers pour que ce soit plus clair.

Merci de votre aide.
 

Pièces jointes

  • Contrôle MP Test2.zip
    48.8 KB · Affichages: 28
  • SYNTHESE CONTROLES.zip
    3.8 KB · Affichages: 28
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : VBA: recherche et remplacement de lignes dans un tableau

Bonjour Anthony53,

Je te propose de reprendre ton code comme suit :

Code: 
Public CheminDuFichierDonnées As String
Public NomDuFichierSynthèse As String
Public NomDuFichierCtrl As String
Public Lg As Long

Sub Export_synthese()
CheminDuFichierDonnées = Range("FeuilleDeTravail!A4").Value
NomDuFichierSynthèse = Range("FeuilleDeTravail!A8").Value
NomDuFichierCtrl = Range("FeuilleDeTravail!A10").Value
Application.ScreenUpdating = False
If Sheets("Bilan").Cells(3, 1).Value = "" Then
MsgBox ("Vous devez sélectionner une matière première et faire un contrôle pour valider les résultats"), vbCritical, "Erreur"
End
Else
Workbooks.Open Filename:=CheminDuFichierDonnées & NomDuFichierSynthèse
Verif
'With Workbooks(NomDuFichierSynthèse).Sheets("Synthèse")
'derl = Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
'End With
Workbooks(NomDuFichierCtrl).Sheets("Bilan").Activate
Sheets("Bilan").Range("A3:AM3").Select
Selection.Copy
Workbooks(NomDuFichierSynthèse).Sheets("Synthèse").Activate
Range("A" & Lg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(NomDuFichierSynthèse).Close savechanges:=True
End If
Workbooks(NomDuFichierCtrl).Sheets("MP et Négoce").Activate
Application.ScreenUpdating = True
MsgBox ("Résultats copiés dans le fichier " & NomDuFichierSynthèse), vbInformation, "Validation des résultats"
End Sub


Sub Verif()
Dim DteCtl
Dim Ver(1 To 6) As Boolean

DteCtl = Sheets("Bilan").Range("A3")
With Workbooks(NomDuFichierSynthèse).Sheets("Synthèse")
  For Each cel In .Range("A:A").SpecialCells(xlCellTypeConstants)
    Select Case cel.Value
      Case Is = DteCtl
        For c = 2 To 6
          If .Cells(cel.Row, c) = Sheets("Bilan").Cells(3, c) Then Ver(c) = True Else Ver(c) = False
        Next
        Ver(1) = Ver(2) * Ver(3) * Ver(4) * Ver(5) * Ver(6)
        If Ver(1) = True Then
          Lg = cel.Row
          Exit Sub
      Case Else
    End Select
  Next
  Lg = .Range("A65536").End(xlUp).Row + 1
End With
End Sub

Je n'ai pas vérifié les résultats car tes fichiers ne comportent aucune donnée, mais je pense que ça devrait fonctionner.

J'ai créé une procédure nommée "Verif" qui recherche dans le classeur "SYNTHESE" les dates correspondantes à la date du contrôle, puis qui compare les colonnes B à F. Si les cellules comparées correspondent, la variable Lg récupère le n° de la ligne en cours d'analyse et la procédure se termine et on revient à la Sub Export_synthese. Autrement, la variable Lg récupère le N° de la 1 ère ligne vide dans le classeur Synthese.

Confirmes-moi si ça fonctionne chez toi.

Dans cette attente.

Cordialement.
 
Vote positif 0 Vote négatif
A

Anthony53

XLDnaute Nouveau
Re : VBA: recherche et remplacement de lignes dans un tableau

Salut Papou-net!

Après quelques infimes corrections dans le code (type ajout End If manquant et le Else dans la condition sur le résultat de Ver(1)), le tout fonctionne nickel!

Merci beaucoup!

Pour info, ci-dessous le code avec mes corrections. (Peut être ai-je ajouté des choses inutiles...)

Code: 
Code:
Public CheminDuFichierDonnées As String
Public NomDuFichierSynthèse As String
Public NomDuFichierCtrl As String
Public Lg As Long

Sub Export_synthese()
CheminDuFichierDonnées = Range("FeuilleDeTravail!A4").Value
NomDuFichierSynthèse = Range("FeuilleDeTravail!A8").Value
NomDuFichierCtrl = Range("FeuilleDeTravail!A10").Value
Application.ScreenUpdating = False
If Sheets("Bilan").Cells(3, 1).Value = "" Then
MsgBox ("Vous devez sélectionner une matière première et faire un contrôle pour valider les résultats"), vbCritical, "Erreur"
End
Else
Workbooks.Open Filename:=CheminDuFichierDonnées & NomDuFichierSynthèse
Verif
Workbooks(NomDuFichierCtrl).Sheets("Bilan").Activate
Sheets("Bilan").Range("A3:AM3").Select
Selection.Copy
Workbooks(NomDuFichierSynthèse).Sheets("Synthèse").Activate
Range("A" & Lg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(NomDuFichierSynthèse).Close savechanges:=True
End If
Workbooks(NomDuFichierCtrl).Sheets("MP et Négoce").Activate
Application.ScreenUpdating = True
MsgBox ("Résultats copiés dans le fichier " & NomDuFichierSynthèse), vbInformation, "Validation des résultats"
End Sub

Sub Verif()
Dim DteCtl
Dim Ver(1 To 6) As Boolean

DteCtl = Workbooks(NomDuFichierCtrl).Sheets("Bilan").Range("A3")
With Workbooks(NomDuFichierSynthèse).Sheets("Synthèse")
  For Each cel In .Range("A:A").SpecialCells(xlCellTypeConstants)
    Select Case cel.Value
      Case Is = DteCtl
        For c = 2 To 6
          If .Cells(cel.Row, c) = Workbooks(NomDuFichierCtrl).Sheets("Bilan").Cells(3, c) Then Ver(c) = True Else Ver(c) = False
        Next
        Ver(1) = Ver(2) * Ver(3) * Ver(4) * Ver(5) * Ver(6)
        If Ver(1) = True Then
          Lg = cel.Row
        Else: Lg = Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
          End If
          Exit Sub
      Case Else
    End Select
  Next
  Lg = Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
End With
End Sub
 
Vote positif 0 Vote négatif
A

Anthony53

XLDnaute Nouveau
Re : VBA: recherche et remplacement de lignes dans un tableau

Salut!

Après essais plus poussés, je me rends compte que le code n'est pas suffisant. En effet lorsque la boucle avec For each s'exécute, elle s'arrête à la première valeur trouvée (et fait la vérification d'égalité: ver) au lieu de s'exécuter sur toutes les égalités où cel.Value = DteCtl et vérifier ensuite si il y a égalité sur les colonnes 1 à 6, enfin lorsqu'une égalité est touvée (ver(1)=True), sélectionner la ligne en question.

Il doit manquer quelque chose...

Merci de votre aide.
 
Vote positif 0 Vote négatif
A

Anthony53

XLDnaute Nouveau
Re : VBA: recherche et remplacement de lignes dans un tableau

Bonjour,

J'ai finalement trouvé la solution à mon dernier problème. En plus je raisonne non plus sur la date de contrôle mais sur le code article. Pour info, voici le code:
Code: 
Public CheminDuFichierDonnées As String
Public NomDuFichierSynthèse As String
Public NomDuFichierCtrl As String
Public Lg As Long

Sub Export_synthese()
CheminDuFichierDonnées = Range("FeuilleDeTravail!A4").Value
NomDuFichierSynthèse = Range("FeuilleDeTravail!A8").Value
NomDuFichierCtrl = Range("FeuilleDeTravail!A10").Value
Application.ScreenUpdating = False
If Sheets("Bilan").Cells(3, 1).Value = "" Then
MsgBox ("Vous devez sélectionner une matière première et faire un contrôle pour valider les résultats"), vbCritical, "Erreur"
End
Else
Workbooks.Open Filename:=CheminDuFichierDonnées & NomDuFichierSynthèse
Verif
Workbooks(NomDuFichierCtrl).Sheets("Bilan").Activate
Sheets("Bilan").Range("A3:AN3").Select
Selection.Copy
Workbooks(NomDuFichierSynthèse).Sheets("Synthèse").Activate
Range("A" & Lg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(NomDuFichierSynthèse).Close savechanges:=True
End If
Workbooks(NomDuFichierCtrl).Sheets("MP et Négoce").Activate
Application.ScreenUpdating = True
MsgBox ("Résultats enregistrés dans le fichier " & NomDuFichierSynthèse), vbInformation, "Validation des résultats"
End Sub

Sub Verif()
Dim CodeArt
Dim Cel As Range
Dim Ver(2 To 8) As Boolean

CodeArt = Workbooks(NomDuFichierCtrl).Sheets("Bilan").Range("B3")
With Workbooks(NomDuFichierSynthèse).Sheets("Synthèse")
  For Each Cel In .Range("B:B").SpecialCells(xlCellTypeConstants)
    Select Case Cel.Value
      Case Is = CodeArt
        For c = 3 To 8
          If .Cells(Cel.Row, c) = Workbooks(NomDuFichierCtrl).Sheets("Bilan").Cells(3, c) Then Ver(c) = True Else Ver(c) = False
            'MsgBox (.Cells(Cel.Row, c) & " = " & Workbooks(NomDuFichierCtrl).Sheets("Bilan").Cells(3, c) & " = " & Ver(c)), vbInformation, info
        Next
        Ver(2) = Ver(3) * Ver(4) * Ver(5) * Ver(6) * Ver(7) * Ver(8)
            'MsgBox (Ver(2)), vbInformation, info
        If Ver(2) = True Then
        Select Case MsgBox("Souhaitez vous remplacer les résultats du contrôle suivant:" & Chr(10) & _
                " " & Chr(10) & _
                "Code Produit: " & Cel.Value & Chr(10) & _
                "Produit: " & Cel.Offset(0, 2).Value & Chr(10) & _
                "Fournisseur: " & Cel.Offset(0, 1).Value & Chr(10) & _
                "N°Lot: " & Cel.Offset(0, 3).Value & Chr(10) & _
                "Multiple: " & Cel.Offset(0, 4).Value & Chr(10) & _
                "DLUO: " & Cel.Offset(0, 5).Value & Chr(10) & _
                "Date Réception: " & Cel.Offset(0, 6), vbOKCancel, "Contrôle déjà validé...")
                Case vbCancel
                Workbooks(NomDuFichierSynthèse).Close savechanges:=False
                End
                Case vbOK
                Lg = Cel.Row
                Exit Sub
        End Select
        End If
      Case Else
    End Select
  Next
  Lg = Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
End With
End Sub

Merci à Papou-net pour son aide.
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
422
chaelie2015
chaelie2015
R
  • Résolu(e)
XL 2019 Recherche valeur (Critère date et ID) et copier valeur dans tableau dans la cellule correspondante
3 4 5
Réponses
66
Affichages
2 K
Rabeto
R
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
297
Akortys
Akortys
S
  • Question
XL 2019 Regroupement et report de données
Réponses
2
Affichages
223
AtTheOne
AtTheOne
C
  • Résolu(e)
XL 2019 Problème d'ajout automatique de lignes à un tableau : la première s'ajoute au tableau mais pas les suivantes !
Réponses
9
Affichages
267
Clemee61
C
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
245
ftpo69
F
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom
Réponses
10
Affichages
321
chaelie2015
chaelie2015
A
  • Résolu(e)
XL 2016 Ajout automatique d'une liste dans un tableau structuré
Réponses
12
Affichages
456
goube
goube
L
  • Question
XL 2021 recherche de valeurs
Réponses
3
Affichages
203
sylvanu
sylvanu
D
  • Question
XL 2010 suppression de lignes dans un fichier EXCEL via une routine en VBA
Réponses
2
Affichages
348
mapomme
mapomme

Membres actuellement en ligne

1 membres et 50 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 668
Messages
2 090 739
Membres
104 644
dernier inscrit
MOLOKO67