Sujet Précédent Sujet Suivant

VBA, problème dans ma fonction IF

Résolu/Fermé
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014 - 22 juil. 2014 à 11:15
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014 - 25 juil. 2014 à 09:31
Bonjour,
Je travaille sur un projet, je dois transférer des données entre 2 fichiers excel. Ce sont des listes de matériels identifiés par un numéro d'agence.
Je dois comparer chaque numéro, et les gérer selon les cas suivants :
Si on retrouve le même numéro je recopie les caractéristiques associées sinon je créé une nouvelle ligne avec toutes les données associées.
Je ne comprends pas pourquoi ma condition du IF n'est jamais vrai alors que j'ai fait le test avec deux fichiers comportant des n° d'agence identique.
Pourriez-vous m'expliquer et me donner une solution à mon erreur ?

De plus, je n'arrive pas à trouver une solution pour mon deuxième problème. J'aimerais que si le matériel existe déjà il ne créé pas de ligne supplémentaire.
Merci d'avance de votre aide

Voici mon code..

Sub CopierDonnees()

Dim Entree As Workbook, Sortie As Workbook

Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
' On ouvre le classeur
Set Veritas = Workbooks.Open(Nomfichierentree)

NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)


Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer



i = 4 'numéro de la première cellule à comparer du fichier SIOUX


j = 2 'numéro de la première cellule à comparer du fichier Veritas


k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Veritas.Worksheets(1).Range("C65536").End(xlUp).row



'Copier/coller des données


While (j < lg2 And k < 65536)


For i = 4 To lg

' si le num d'agence est identique alors je modifie les données
If (Veritas.Worksheets(1).Range("U" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then


'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Veritas

Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value


'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Veritas
Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value



'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Veritas.Worksheets(1).Range("U" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX

Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("P" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("Q" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("R" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("W" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("I" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("K" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("J" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("V" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("Q" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("F" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("V" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("S" & j).Offset(lig).Value


End If

Next


k = k + 1
j = j + 1


Wend


' On ferme le classeur
Sioux.Close


End If
' On ferme le second
Veritas.Close
End If


End Sub

3 réponses

Réponse 1 / 3
WeaponEDGE Messages postés 113 Date d'inscription vendredi 18 juillet 2014 Statut Membre Dernière intervention 21 novembre 2014 9
22 juil. 2014 à 11:26
Bonjour,

Pour t'aider, dans le visual Basic Editor affiche la fenêtre "Données Local" (dans ma version anglaise c'est "Local Windows"). Dans cet écran s'affichera toutes tes variables avec le contenu de chacune.

Exécute ta macro pas à pas avec la touche F8 et compare le contenu des variable que tu met en confrontation.
Le problème peux venir du format des cellule comparé. Une cellule au format texte apparaitra entre Guillemet alors qu'une donnée numérique apparaitra en brute.

Pour ton 2eme problèmes Si tu pouvais fournir 2 fichiers en exemple (via le site cijoint.com) avec juste 3 ligne de contenu, ça serait surper.
1
Réponse 2 / 3
WeaponEDGE Messages postés 113 Date d'inscription vendredi 18 juillet 2014 Statut Membre Dernière intervention 21 novembre 2014 9
22 juil. 2014 à 15:43
Rebonjour,

J'ai réécrit une partie du code que voici :

Je te laisse compléter le code aux endroits où c'est mentionné "mettre les instructions".
Si tu as des questions n'hésites pas.

Sub CopierDonnees()

Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant

CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name

CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name

k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX

Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True

'Copier/coller des données

' Trouve = 0
While k < Rows.Count
For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text

For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text

If RefENTREE = RefSORTIE Then

'Mettre les instructions sur la ligne u du Fichier Sortie
' Trouve = 1
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
Next i
k = k + 1
Wend
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
1
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014
23 juil. 2014 à 09:04
j'ai un petit souci, je sais pas si ca vient de moi, mais le prog n'arrive pas à se terminer et il plante mon ordi....
0
WeaponEDGE Messages postés 113 Date d'inscription vendredi 18 juillet 2014 Statut Membre Dernière intervention 21 novembre 2014 9
23 juil. 2014 à 13:59
As tu testé la macro pas à pas avec la touche F8 pour voir quand ça plante ?
0
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014
23 juil. 2014 à 15:57
en faisant pas à pas il va créer et inscrire indéfiniment la dernière ligne du fichier d'entrée dans celui de sortie
c'est peut être que j'ai mal compris ce qu'il fallait incorporer dans les 'mettre les instructions'

j'ai mis
'Mettre les instructions sur la ligne u du Fichier Sortie
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra

Workbooks(NomFichierSortie).Worksheets(1).Range("J" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("F" & i).Value


'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Value


'Mettre les instruction sur la ligne k du fichier Sortie
Workbooks(NomFichierSortie).Worksheets(1).Range("B" & k).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("C" & i).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("E" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("A" & i).Offset(lig).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("G" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("B" & i).Offset(lig).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("R" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("D" & i).Offset(lig).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Offset(lig).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("L" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("K" & i).Offset(lig).Value

Workbooks(NomFichierSortie).Worksheets(1).Range("K" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("L" & i).Offset(lig).Value
0
WeaponEDGE Messages postés 113 Date d'inscription vendredi 18 juillet 2014 Statut Membre Dernière intervention 21 novembre 2014 9
24 juil. 2014 à 09:38
Ah non ça vient de mon code :
Voici la verion modifiée :

Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant

CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name

CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name

k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX

Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True

'Copier/coller des données

For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text

For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text

If RefENTREE = RefSORTIE Then

'Mettre les instructions sur la ligne u du Fichier Sortie
u = 0
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
k = k + 1
If k > Rows.Count Then
MsgBox ("La limite de la feuille est atteinte")
Exit For
End If
Next i
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
0
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014
24 juil. 2014 à 10:06
merci bcp! ca marche très bien!
0
Réponse 3 / 3
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014
22 juil. 2014 à 12:18
Merci pour la rapidité de ta réponse =)
J'avais du m'emmêler comme j'ai créé un prog pratiquement identique puisqu'il fallait que je gère un fichier du même type mais avec des données organisées différemment et celui là marchait; J'ai copié et collé ce prog en modifiant qq lignes et ca a marché!

Pour mon deuxième problème, j'ai joint mes deux fichiers.
j'ai mis en rouge sur mon fichier de sortie les données qui étaient présente avant l'application de mon prog. On s'aperçoit qu'il a donc créé une ligne même si l'article existait, j'aimerais qu'il n y est plus de duplication (ligne 7 et 5)
Merci pour l'aide!

https://www.cjoint.com/?3GwmmnnFzfw
https://www.cjoint.com/?3GwmnNAMmYx
0
WeaponEDGE Messages postés 113 Date d'inscription vendredi 18 juillet 2014 Statut Membre Dernière intervention 21 novembre 2014 9
24 juil. 2014 à 10:34
J'aurais besoin du code complet afin que je puisse le tester peux tu me le joindre ?
0
gathou13 Messages postés 12 Date d'inscription mardi 22 juillet 2014 Statut Membre Dernière intervention 30 juillet 2014
25 juil. 2014 à 09:31
le voici, mais le tien marche très bien

Sub CopierDonnees()

Dim Dekra As Workbook, Sioux As Workbook

NomFichierEntree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
' On ouvre le classeur
Set Dekra = Workbooks.Open(NomFichierEntree)

NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)


Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer



i = 4 'numéro de la première cellule à comparer du fichier SIOUX


j = 2 'numéro de la première cellule à comparer du fichier DEKRA


k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Dekra.Worksheets(1).Range("C65536").End(xlUp).row



'Copier/coller des données


While (j < lg2 And k < 65536)


For i = 4 To lg

' si le num d'agence est identique alors je modifie les données
If (Dekra.Worksheets(1).Range("C" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then


'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra

Sioux.Worksheets(1).Range("J" & i).Value = Dekra.Worksheets(1).Range("F" & j).Value


'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Sioux.Worksheets(1).Range("AA" & i).Value = Dekra.Worksheets(1).Range("E" & j).Value



'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Dekra.Worksheets(1).Range("C" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX

Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("A" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("B" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("D" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("E" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("K" & j).Offset(lig).Value

Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("L" & j).Offset(lig).Value


End If

Next


k = k + 1
j = j + 1


Wend


' On ferme le classeur
Sioux.Close


End If
' On ferme le second
Dekra.Close
End If


End Sub
0

Discussions similaires

"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse
Fonction if exist et else
Xena3 -
Xena3 -

6 réponses
VBA : Range avec références variables..
Antoine -
MIKE59 -

7 réponses
VBA erreur 1004
séverine -
Floroan -

9 réponses