VBA: recherche et remplacement de lignes dans un tableau

Anthony53 · 16 Mars 2011

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.

Papou-net · 16 Mars 2011

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.

Anthony53 · 17 Mars 2011

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

Anthony53 · 21 Mars 2011

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.

Anthony53 · 22 Mars 2011

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.

VBA: recherche et remplacement de lignes dans un tableau

Anthony53

Guest

Pièces jointes

Papou-net

XLDnaute Barbatruc

Anthony53

Guest

Anthony53

Guest

Anthony53

Guest

Discussions similaires

VBA: recherche et remplacement de lignes dans un tableau

Anthony53

Guest

Pièces jointes

Papou-net

XLDnaute Barbatruc

Anthony53

Guest

Anthony53

Guest

Anthony53

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency