Récupération de données avec comparaison d'un champ

moteurV12

XLDnaute Occasionnel
Bonjour,

Tout d'abords je precise que je suis totalement nul en vba et que je debute. :pt1cable:

j'ai un fichier principal " suivi complet " sur lequel je travaille tous les jours ( ajout de lignes, suppressions de lignes, modifications de valeurs de cellules et commentaires n'importe où dans le fichier )

Ce fichier est copié tous les jours ( aprés filtrage sur 1 critère, verrouillage de certaines colonnes, suppressions de colonnes confidentielles) sur un serveur ftp afin que les personnes concernés puisque remplir les colonnes non vérouillée les concernant, puissent ajouter des commentaires etc )

Les colonnes accessibles en écriture sont toujours X,Z,AB,AD,AE,AF,AG,AI,AK,AM,AO,AQ,AS,AU,AW,AX,AY,AZ,BA,BB,BC,BD,BE,BF,BG,BH sur le fichier que l'on va appelé Bill.

le fichier d'origine comporte au début un colonne en plus, supprimée lors du transfert, donc par exemple la colonne X en "Bill" est la colonne Y en "suivi complet"
Il comporte aussi pas mal de colonnes supplémentaires en fin.

la colonne A du fichier "Bill" comporte une numérotation de ligne et c'est la colonne B en "suivi complet"

le Problème

je souhaiterai récupérer chaque jour les valeurs et commentaires (copy) de "Bill" et les retranscrire dans le fichier maitre en comparant la valeur Ax de bill à Bx de suivi complet
et si Ax = Bx
alors copy des cellules concernées de la ligne, et surtout pas de la ligne complète.
je rappelle que des lignes peuvent avoir été supprimées n'importe ou et d'autres ajoutées en fin tous les jours sur le fichier maître

Voilà j'espere avoir été assez clair. sinon je répondrai à vos interrogations subsidiaires.
Cela fait 15 jours que je planche sur ce probleme et je n'arrive pas à récuperer à la fois les cellules et les coms.

Autres précisions qui a peut être son importance, à terme c'est une trentaines de fichiers que je devrai récupérer situés dans différents répertoires utilisateurs du serveur FTP.

Voili, Voilà

Merci de venir à mon secours :)
 

skoobi

XLDnaute Barbatruc
Re : Récupération de données avec comparaison d'un champ

Bonjour,

C'est appréciable de voir que tu prends le temps de bien expliquer le problème que tu rencontres mais tu oublis l'essentiel: les 2 fichiers exemples (48,8 Ko maxi par fichier).

Bon WE.
 

skoobi

XLDnaute Barbatruc
Re : Récupération de données avec comparaison d'un champ

Re,

Voilà ce que ça donne.
J'ai mis des commentaires dans le code pour la compréhension:

Code:
'Dim LigneActive As Long 'dans la feuille à lire
'Dim DerniereLigne As Long 'dans la feuille à lire

Dim FileDir As String
Dim Filenumber As String
Const MotdePasse = "moustike"
'--------remarque skoobi: ligne suivante pour mes tests
'Const FilePath = "F:\VBA\VBA excel\Forum Excel-Download"
Const FilePath = "C:\Documents and Settings\JEAN_MICHEL\Bureau\" '<<< Change this to your directory
Const FileOri = "C:\Documents and Settings\JEAN_MICHEL\Bureau\" '<<< Change this to your directory


Sub Macro4()
'déclararion des variables
  Dim ShSource As Worksheet, ShSuivi As Worksheet, LineNbr As Range, TrouveLineNbr As Range, Lig As Long

  Set ShSuivi = ThisWorkbook.Sheets("General")
'--------remarque skoobi: pourquoi? le fichier n'est pas modifié à l'ouverture
'  ActiveWorkbook.Save
  
    FileDir = FilePath & "Chine\" & "Bill.xls"
    
'--------remarque skoobi: ligne suivante pour mes tests
'    FileDir = FilePath & "\Bill.xls"
  
    Workbooks.Open Filename:= _
                      FileDir, Password:="OCH12W"
'--------remarque skoobi: ligne suivantes inutiles
  '  Sheets(Array("General")).Select
  '
  '  Range("A2").Select

  '  While ActiveCell.value <> Empty
  '    LigneActive = ActiveCell.Row  'n° de la ligne "à lire"
  '    If Cells(LigneActive, 5).value = "BILL" Then
  '      DerniereLigne = LigneActive
'écriture dans la feuille "General"
  '      With Workbooks("SUIVI COMPLET.xls").Sheets("General")
  Set ShSource = ActiveWorkbook.Sheets("General")
  With ShSource
'on déprotège la feuille
    .Unprotect "moustike"
'pour chaque "Line NBRE" visible
    For Each LineNbr In .Range("A2", .[A65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
'on récupère la ligne
      LigSource = LineNbr.Row
'on cherche ce "Line NBRE" dans le fichier "suivi"
      Set TrouveLineNbr = ShSuivi.Range("B2", ShSuivi.[B65536].End(xlUp)).Find(LineNbr, LookIn:=xlValues, lookat:=xlWhole)
'si ce "Line NBRE" est trouvé
      If Not TrouveLineNbr Is Nothing Then
'on récupère la ligne sur laquelle les données seront collées
        Lig = TrouveLineNbr.Row
'et là le copier/coller des colonnes souhaitées
        .Cells(LigSource, 24).Copy ShSuivi.Cells(Lig, 25)
        .Cells(LigSource, 26).Copy ShSuivi.Cells(Lig, 27)
        .Cells(LigSource, 28).Copy ShSuivi.Cells(Lig, 29)
        .Range(.Cells(LigSource, 30), .Cells(LigSource, 33)).Copy ShSuivi.Cells(Lig, 31)
        .Cells(LigSource, 35).Copy ShSuivi.Cells(Lig, 36)
        .Cells(LigSource, 37).Copy ShSuivi.Cells(Lig, 38)
        .Cells(LigSource, 39).Copy ShSuivi.Cells(Lig, 40)
        .Cells(LigSource, 41).Copy ShSuivi.Cells(Lig, 42)
        .Cells(LigSource, 43).Copy ShSuivi.Cells(Lig, 44)
        .Cells(LigSource, 45).Copy ShSuivi.Cells(Lig, 46)
        .Cells(LigSource, 47).Copy ShSuivi.Cells(Lig, 48)
        .Range(.Cells(LigSource, 49), .Cells(LigSource, 51)).Copy ShSuivi.Cells(Lig, 50)
        .Range(.Cells(LigSource, 53), .Cells(LigSource, 60)).Copy ShSuivi.Cells(Lig, 54)
      End If
    Next
'on protège la feuille
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="moustike"
  End With

  '    End If
  '    ActiveCell.Offset(1, 0).Activate

  '  Wend
  Workbooks("Bill.XLS").Close SaveChanges:=False
  ShSuivi.Cells.EntireColumn.AutoFit
End Sub
Bonne journée.
 
Dernière édition:

moteurV12

XLDnaute Occasionnel
Re : Récupération de données avec comparaison d'un champ

C'est Nickel
j'ai du y passer 200 h facile dessus Grrrrrrrrrrrr
Je dis chapeau bas, franchement je te suis trés reconnaissant.

ce fut rapide et efficace. c'est exactement ce que je souhaitai:):):)

tu demandes pourquoi ne pas mettre à jour à l'ouverture du fichier principal ce qui semble à priori bcp plus logique.

parce que les fichiers enfants sont modifier avec 5-7h de decalages horaire (Inde, Chine, Bangladesh ) et qu'a terme je vais partager le classeur principal avec 2 autres personnes. ( je crois )

je prefere donc mettre à jour en cliquant sur un bouton.

Je suis cependant preneur d'idées qui m'auraient échappées.

En tout cas vraiment un trés grand merci:rolleyes:
 

moteurV12

XLDnaute Occasionnel
Re : Récupération de données avec comparaison d'un champ

Sans vouloir abuser est il possible de faire une boucle pour recuperer les données de plusieurs fichiers. ( dont voici la liste )

FileDir = FilePath & "INDEFF\" & "Isaac" & ".xls"
FileDir = FilePath & "Chine\" & "Jenny" & ".xls"
FileDir = FilePath & "Bangladesh\" & "Mission" & ".xls"
FileDir = FilePath & "Bangladesh\" & "Moman" & ".xls"
FileDir = FilePath & "INDEFF\" & "Prabha" & ".xls"
FileDir = FilePath & "Inde\" & "Sandeep" & ".xls"
FileDir = FilePath & "Bangladesh\" & "KALED" & ".xls"
FileDir = FilePath & "Bangladesh\" & "PUSHPA" & ".xls"
FileDir = FilePath & "Bangladesh\" & "IQBAL" & ".xls"
FileDir = FilePath & "Inde\" & "KUMAR" & ".xls"
FileDir = FilePath & "Chine\" & "MING" & ".xls"
FileDir = FilePath & "Chine\" & "DENG JIE" & ".xls"
FileDir = FilePath & "Chine\" & "SUZAN" & ".xls"
FileDir = FilePath & "Chine\" & "DIAPENIE" & ".xls"
FileDir = FilePath & "Inde\" & "ANAND" & ".xls"
FileDir = FilePath & "Bangladesh\" & "PAUL" & ".xls"

Joyeux Week-End et merci encore
 

skoobi

XLDnaute Barbatruc
Re : Récupération de données avec comparaison d'un champ

Re,

en bleu les ajouts/modifs. Note que je n'ai pas mis toute la liste, je te laisse compléter (en rouge) ;):

Code:
Sub Macro4()
'déclararion des variables
  Dim ShSource As Worksheet, ShSuivi As Worksheet, LineNbr As Range, TrouveLineNbr As Range, Lig As Long
[COLOR=Blue][B]  Dim ListeFichier As Variant[/B][/COLOR]
  Set ShSuivi = ThisWorkbook.Sheets("General")
  '--------remarque skoobi: pourquoi? le fichier n'est pas modifié à l'ouverture
  '  ActiveWorkbook.Save
[COLOR=Blue][B]  ListeFichier = Array("Chine\Bill.xls", "INDEFF\Isaac.xls", "Chine\Jenny.xls", "Bangladesh\Mission.xls", _
"Bangladesh\Moman.xls", "INDEFF\Prabha.xls", "Inde\Sandeep.xls", "Bangladesh\KALED.xls",[/B][/COLOR][SIZE=4][COLOR=Red][B]etc........[/B][/COLOR][/SIZE][B][COLOR=Blue])[/COLOR][/B]
 [COLOR=Blue][B] For i = LBound(ListeFichier) To UBound(ListeFichier)[/B][/COLOR]

    '--------remarque skoobi: ligne suivante pour mes tests
    FileDir = FilePath & [B][COLOR=Blue]ListeFichier(i)[/COLOR][/B]
    Workbooks.Open Filename:= _
                   FileDir, Password:="OCH12W"
    Set ShSource = ActiveWorkbook.Sheets("General")
    With ShSource
.......
.............
...........
    End With
    [B][COLOR=Blue]ActiveWorkbook[/COLOR][/B].Close SaveChanges:=False
[COLOR=Blue][B]  Next[/B][/COLOR]
  ShSuivi.Cells.EntireColumn.AutoFit
End Sub
 
Dernière édition:

moteurV12

XLDnaute Occasionnel
Re : Récupération de données avec comparaison d'un champ

Le top

j'en ai rêvé et Skoobi l'a fait

petit probleme, chaque fichier à un Password différent
j'aurai du penser à te le dire:D

PRABHA PRAT01K
ISAAC PRAT01W
MOMAN KBD02P
PAUL WBD02L
MISSION SBD02P
PUSHPA YBD02P
KHALED DBD02I
IQBAL DBD02I
JENNY CCN03J
KUMAR KTI04K
SANDEEP KTI05S
MING OHK06M
DENG JIE OSH07D
SUZAN KCH08S
DIAPENIE KCH09A
AWENY OCH10L
ANAND MUI11A
BILL OCH12W

en tout cas ma sincère reconnaissance


j'ai plus appris en 2 jours avec toi qu'en 15 en épluchant le net et l'aide de VBA
 

moteurV12

XLDnaute Occasionnel
Re : Récupération de données avec comparaison d'un champ

j'ai trouvé une façon peu élégante ( me semble t'il )
introduire le nombre de if voulu

If ListeFichier(i) = "INDEFF\Isaac.xls" Then
Workbooks.Open Filename:=FileDir, Password:="PRAT01W"
End If

If ListeFichier(i) = etc etc

C'est ca ??

il existe probablement une manière plus efficace, je le sens

à suivre ( trés instructif )
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 047
Messages
2 084 857
Membres
102 688
dernier inscrit
Biquet78