VBA, problème dans ma fonction IF Résolu

Question

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

WeaponEDGE · Answer

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.

gathou13 · Answer

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

WeaponEDGE · Answer

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

VBA, problème dans ma fonction IF

3 réponses

Discussions similaires

Newsletters