[déplacé BAR - VBA] Extraction de données d'un fichier vers un autre

Question

Bonjour, J'ai le code suivant qui ne fonctionne pas au niveau des conditions. Private Sub CommandButton1_Click() Dim Wb1 As Workbook, wb2 As Workbook, Chemin As String, Fichier As String Dim wb As Workbook Application.ScreenUpdating = False 'j'initialize le premier classeur ici: tableau suivi action en retard Set Wb1 = ThisWorkbook 'j'indique le chemin et le nom du deuxième classeur Chemin = "H:" Fichier = Chemin & TextBox1.Text & ".xls" On Error Resume Next 'je vérifie si le classeur est présent Set wb = GetObject(Fichier) If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub 'j'ouvre le classeur: plan d'actions SMQ Workbooks.Open Fichier 'j'initialize le deuxieme classeur Set wb2 = ActiveWorkbook lig = Wb1.Sheets("Feuil1").[D65536].End(3).Row + 1 With wb2.Sheets("Feuil1") For k = 10 To .[A65536].End(3).Row If .Range("A" & k) <> "" Then 'si les conditions sont remplies alors je vais à extract If Range("W10").Value = "" And Range("U10").Value < Date Then GoTo extract If Range("U10").Value = "" Then GoTo extract If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then GoTo extract If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then GoTo extract Exit Sub extract: Wb1.Sheets("Feuil1").Range("D" & lig).Value = .Range("T" & k).Value Wb1.Sheets("Feuil1").Range("F" & lig).Value = .Range("A" & k).Value Wb1.Sheets("Feuil1").Range("G" & lig).Value = .Range("G" & k).Value Wb1.Sheets("Feuil1").Range("H" & lig).Value = .Range("P" & k).Value Wb1.Sheets("Feuil1").Range("I" & lig).Value = .Range("M" & k).Value Wb1.Sheets("Feuil1").Range("J" & lig).Value = .Range("H" & k).Value Wb1.Sheets("Feuil1").Range("K" & lig).Value = .Range("O" & k).Value lig = lig + 1 End If Next k End With 'je referme le classeur plan d'action sans sauvegarder wb2.Close 'j'active le classeur tableau suivi Wb1.Sheets("Feuil1").Activate Application.ScreenUpdating = True 'je referme l'userform Unload UserForm1 End Sub Voici les conditions pour que l'extraction se fasse correctement : 1) si il n'y a pas de date en U10 on recopie la ligne conformément à l'extraction 2) si il y a une date en U10 et que celle-ci est < à aujourd'hui et qu'en W10 il n'y a pas de date, on recopie la ligne conformément à l'extraction. (si U10 la date est > à aujourd'hui et qu'en W10 il n'y a pas de date, on passe à l'analyse de la ligne suivante sans recopier) 3) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si ce n'est pas le cas, on recopie la ligne conformément à l'extraction 4) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si c'est le cas on vérifie si elle est < à aujourd'hui, si c'est le cas, on vérifie si en AD10 une date est saisie, si c'est pas le cas on recopie la ligne conformément à l'extraction. (si AD10 est complétée on passe à l'analyse de la ligne suivante sans recopier) 5) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si c'est le cas on vérifie si elle est < à aujourd'hui, si c'e n'est pas le cas, on passe à l'analyse de la ligne suivante sans recopier. Je vous remercie de votre aide.

jordane45 · Answer

Bonjour,
En regardant rapidement, je constate qu'actuellement, pour chaque IF.. tu vas systématiquement à Extract. (alors que d'apres tes explications, un traitement différent doit etre fait.)

J'ai le code suivant qui ne fonctionne pas au niveau des conditions. 

Pourrais tu nous préciser quelle(s) condition(s) ne fonctionne pas et en quoi ça ne marche pas ?

si U10 la date est > à aujourd'hui et qu'en W10 il n'y a pas de date, on passe à l'analyse de la ligne suivante sans recopier
Pour indiquer au programme de passer à la ligne suivante (enfin.. au prochain next) il te faut utiliser l'instruction : Resume Next

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

jordane45 · Answer

Bonjour,
oula;.. je suis pas révéillé ce matin.
oublie ce que j'ai marqué :
Pour indiquer au programme de passer à la ligne suivante (enfin.. au prochain next) il te faut utiliser l'instruction : Code Visual Basic :
Resume Next

en fait, ça n'a rien à voir... 

bref, ce que je voulais dire, c'est..; si tu ne dois pas faire l'extract ... le mieux c'est de le placer dans ton bloc IF (ainsi.. si la condition n'est pas vérifiée.. il ne le lancera pas).
tu pourrais par exemple placer le code pour faire ton extract dans une fonction et ne l'appeller que lorsque la condition est vrai (plutot que d'utiliser des LABEL )

exemple: 

Sub test()

For l = 1 To 10
    ' ne lance la fonction extract que si L = 5
    If l = 5 Then extract (l)
Next

End Sub

Function extract(ligne)
'ceci est ma fonction
    MsgBox ligne
End Function


Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

cs_thomasdu40 · Answer

Bonjour Jordane et merci de ta réponse,

Apparemmnent et étant novice en VBA il m'est très difficile de re écrire mon code avec tes explications. Mais je ne demande qu'à apprendre alors si tu peux me donner un exemple avec une de mes conditions.

Par avance merci.

jordane45 · Answer

Bonjour, vite fait.. (je n'ai pas revérifier tes conditions...) Mais en utilisant ce que je t'ai proposé.. ça donnerai ça : Private Sub CommandButton1_Click() Dim Chemin As String Dim Fichier As String Application.ScreenUpdating = False 'j'initialize le premier classeur ici: tableau suivi action en retard Set Wb1 = ThisWorkbook 'j'indique le chemin et le nom du deuxième classeur Chemin = "H:" Fichier = Chemin & TextBox1.Text & ".xls" On Error Resume Next 'je vérifie si le classeur est présent Set Wb = GetObject(Fichier) If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub 'j'ouvre le classeur: plan d'actions SMQ Workbooks.Open Fichier 'j'initialize le deuxieme classeur Set Wb2 = ActiveWorkbook Lig = Wb1.Sheets("Feuil1").[D65536].End(3).Row + 1 With Wb2.Sheets("Feuil1") For k = 10 To .[A65536].End(3).Row If .Range("A" & k) <> "" Then 'si les conditions sont remplies alors je vais à extract If Range("W10").Value = "" And Range("U10").Value < Date Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 End If If Range("U10").Value = "" Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 End If If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 End If If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 End If 'Je pense que c'est ton Exit sub qui doit géner... 'Exit Sub ' Si aucune condition vraie... alors quitter la macro End If Next k End With 'je referme le classeur plan d'action sans sauvegarder Wb2.Close 'j'active le classeur tableau suivi Wb1.Sheets("Feuil1").Activate Application.ScreenUpdating = True 'je referme l'userform Unload UserForm1 End Sub Il faut aussi que tu places ce code dans ton module principale (celui qui appel ton userform) ' Code à placer dans le module principale ' déclaration des variables en "Public" pour pouvoir les utiliser dans TOUT le code Public Wb1 As Workbook Public Wb2 As Workbook Public Wb As Workbook Sub main() Load userform1 userform1.Show End Sub Function extract(Ligne1ne1, Ligne2) '--------------------------------------------------------------------- ' Fonction Extract. ' En argument, on passe Ligne1 (= Lig) et Ligne2 (=K) '--------------------------------------------------------------------- Wb1.Sheets("Feuil1").Range("D" & ligne1).Value = .Range("T" & Ligne2).Value Wb1.Sheets("Feuil1").Range("F" & ligne1).Value = .Range("A" & Ligne2).Value Wb1.Sheets("Feuil1").Range("G" & ligne1).Value = .Range("G" & Ligne2).Value Wb1.Sheets("Feuil1").Range("H" & ligne1).Value = .Range("P" & Ligne2).Value Wb1.Sheets("Feuil1").Range("I" & ligne1).Value = .Range("M" & Ligne2).Value Wb1.Sheets("Feuil1").Range("J" & ligne1).Value = .Range("H" & Ligne2).Value Wb1.Sheets("Feuil1").Range("K" & ligne1).Value = .Range("O" & Ligne2).Value End Function Voila c'est comme ça que je verrai la chose. A toi de tester (en mode pas à pas pour voir où ça bloque éventuellement) Cordialement, Jordane, ______________________________________________________ Règles du forum à lire avant de poster une question : ICI

jordane45 · Answer

Arf... j'ai vraiment trop de mal ce matin ... désolé.


Penses aussi à ajouter le Wb2 dans la fonction

  Wb1.Sheets("Feuil1").Range("D" & ligne1).Value = Wb2.Sheets("Feuil1").Range("T" & Ligne2).Value

Je pense que je vais devoir aller me boirre 2-3 litres de café avant de continuer à poster. 
Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

cs_thomasdu40 · Answer

Je suis fatigué d'essayer de chercher surtout si cela me paraît impossible.

Merci Jordane, j'ai intégré tes codes mais voici l'erreur qui apparaît :
Erreur de compilation :
Seuls des commentaires peuvent apparaître après End Sub, End Fonction,..
Le mot "public" est mis en surbrillance du code suivant :
Public Wb1 As Workbook
    Public Wb2 As Workbook
    Public Wb As Workbook

cs_Orohena · Answer

Salut

    Public Wb1 As Workbook
    Public Wb2 As Workbook
    Public Wb As Workbook


Il suffit de déplacer ces trois lignes tout en haut de de la feuille Visual Basic, 
c'est-à-dire au-dessus de tous tes Sub/End Sub et Function/End Function.

Comme elles ont une portée globale, elles doivent précéder les procédures.

Ne te décourage pas

cs_thomasdu40 · Answer

Bonjour Orohena,

J'ai eu enfin le temps de faire l'opération suivant ton conseil. Cette fois-ci le problème est résolu sauf que maintenant il me copie3 fois les mêmes lignes.
Aussi il ne respecte pas les If.

Cette macro me semble irréalisable totalement irréalisable.

cs_Orohena · Answer

Bonjour 1. Il me copie 3 fois les mêmes lignes. Cela parait normal, car le code passe systématiquement par les trois If : If Then ... End If If Then ... End If If Then ... End If Pour éviter cela, on devrait lire : If Then ... Else If Then ... Else If Then ... End If Avec la clause Else If, il ne peux pas y avoir plus d'une extraction. 2. Aussi il ne respecte pas les If Cela est peut-être dû au fait que tes conditions comptent un certain nombre d'opérateurs And et Or, sans parenthèse. VBA applique des règles de priorité des opérateurs, décrites dans la doc en ligne. Pour y accéder, mets le curseur sur un opérateur, "And" par exemple, et appuie sur F1. Clique sur la ligne "VBA". Dans la fenêtre d'aide, clique sur "Voir aussi", puis sur "Priorité des opérateurs". Cordialement

cs_thomasdu40 · Answer

Bonjour, Pour les And et Or, là dsl mais sur le pc du boulot je ne peux pas procéder comme tu dis en faisant F1 car les fichiers d'aide sont manquants. Pour Else : Voici le message d'erreur indiqué :Erreur de compilation : Erreur de syntaxe Voici un extrait du code : If Range("W10").Value = "" And Range("U10").Value < Date Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 Else If Range("U10").Value = "" Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 Else If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 Else If Range("W10").Value <> "" And Range("M10").Value "Audit blanc ISO" Or Range("M10").Value "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then 'Appel de la fonction extract Extr = extract(Lig, k) Lig = Lig + 1 End If

rv83toulon · Answer

Bonjour a tous, bonjour thomas,
Bonjour Jordane et merci de ta réponse, 

Apparemmnent et étant novice en VBA il m'est très difficile de re écrire mon code avec tes explications. 
Excuse moi mais tu auras forcémment du mal puisque tu ne l'as pas écris.  (Merci à moi).

Bref, je n''ai volontairement pas réécrit les conditions puisque au départ tu n'avais rien préciser à ce sujet sur l'autre forum.
L'ami Mercatog sur l'autre forum t'avais donné un code qui reprenais les conditions avec Des IF AND OR. 
Tu es débutant, soit, mais pour la pratique prendre des bouts de code d'un côté puis de l'autre est déroutant lorsqu'on commence, je parle en connaissance de cause j'ai fait pareil.

tu dis : Pour les And et Or, là dsl mais sur le pc du boulot je ne peux pas procéder comme tu dis en faisant F1 car les fichiers d'aide sont manquants. 

OK, mais as tu eu l'idée de parcourir les excellents tutos des 2 sites ainsi que les FAQ sur EXCEL et sur le VBA ? tu trouveras les explications.

pour ceux que ceci intéresse voici le lien vers les fichiers de thomas:
Tapez le texte de l'url ici.
@+

[déplacé BAR -> VBA] Extraction de données d'un fichier vers un autre

11 réponses

Votre réponse

Discussions similaires