VBA, problème dans ma fonction IF

Résolu
gathou13 Messages postés 13 Statut Membre -  
gathou13 Messages postés 13 Statut Membre -
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

  1.
    WeaponEDGE Messages postés 114 Statut Membre 9
     
    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
  2. WeaponEDGE Messages postés 114 Statut Membre 9
     
    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
    1. gathou13 Messages postés 13 Statut Membre
       
      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
    2. WeaponEDGE Messages postés 114 Statut Membre 9
       
      As tu testé la macro pas à pas avec la touche F8 pour voir quand ça plante ?
      0
    3. gathou13 Messages postés 13 Statut Membre
       
      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
    4. WeaponEDGE Messages postés 114 Statut Membre 9
       
      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
    5. gathou13 Messages postés 13 Statut Membre
       
      merci bcp! ca marche très bien!
      0
  3. gathou13 Messages postés 13 Statut Membre
     
    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
    1. WeaponEDGE Messages postés 114 Statut Membre 9
       
      J'aurais besoin du code complet afin que je puisse le tester peux tu me le joindre ?
      0
    2. gathou13 Messages postés 13 Statut Membre
       
      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

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

0 réponse
Message "cette fonction n'est pas disponible actuellement"
daladala -
Lucaslebg -

15 réponses
A quoi sert la sortie IF OUT démodulateur?
LesNulsCCM -
Graffitir -

3 réponses
Message récurrent sur TV LG LED HD
bullshitt -
ghsi med -

5 réponses
VBA : dysfonctionnement fonction Find : Excel ne trouve pas des valeurs
GG69 -
eriiic -

4 réponses