[VBA] récupérer des données ailleurs
t
Hello,
Je suis débutant sur VBA (j'ai quand même une grosse maitrise sur Excel et de SAS donc je cerne l'idée).
Je dois améliorer une macro existante pour récupérer des informations provenant d'un autre fichier Excel. De ce que j'ai compris pour l'instant du code c'est que les données avec une apostrophe (en vert, qui font office de texte) sont ce que je suis censé faire pour mon boss. J'ai testé la macro en retirant les apostrophes. Ca marche moyen mais ça s'en approche pas mal quand même.
Dans les grandes lignes je comprends ce que je vois sur mon fichier de code mais est ce que quelqu'un serait assez gentil pour m'expliquer ce que mon code fait précisément je demande pas une explication ligne par ligne mais paragraphe par paragraphe ce serait cool.
Un grand merci à celui/celle qui m'aidera
'Cette routine permet de récupérer les données manquantes sur l'extraction XXXXX
Sub recuperation_DonneesComplemenataireARKEA()
Application.ScreenUpdating = False
Set wbCible = ThisWorkbook
Set wsCible = Worksheets("Données")
wsCible.Activate
Range(Cells(2, 38), Cells(500000, 38)).Select
Selection.ClearContents
Range(Cells(2, 57), Cells(500000, 57)).Select
Selection.ClearContents
Range(Cells(2, 29), Cells(500000, 31)).Select
Selection.ClearContents
sFichier = Application.GetOpenFilename(, , "Sélectionnez le fichier")
If sFichier = False Then
Exit Sub
Else
Workbooks.Open Filename:=sFichier
Set wbSource = ActiveWorkbook
End If
Application.DisplayAlerts = False
wbSource.Sheets("Fichier TCI").Activate
Range("B1").Select
Selection.End(xlDown).Select
nbLigne = Selection.Row
For i = 2 To nbLigne
NumDossier = wbSource.Sheets("Fichier TCI").Cells(i, 3).Value
Marche = wbSource.Sheets("Fichier TCI").Cells(i, 5).Value
produit = wbSource.Sheets("Fichier TCI").Cells(i, 12).Value
MargeClientCNU = wbSource.Sheets("Fichier TCI").Cells(i, 6).Value
TCICNU = wbSource.Sheets("Fichier TCI").Cells(i, 7).Value
TMCCNU = wbSource.Sheets("Fichier TCI").Cells(i, 8).Value
'MontantEngagement = wbSource.Sheets("Fichier TCI").Cells(i, 9).Value
date_debut_Phase_Mob = wbSource.Sheets("Fichier TCI").Cells(i, 10).Value
date_Fin_Phase_Mob = wbSource.Sheets("Fichier TCI").Cells(i, 11).Value
wbCible.Activate
wsCible.Activate
Set ZoneNum = wsCible.Range(Cells(1, 7), Cells(500000, 7))
ZoneNum.Select
Set c = ZoneNum.Find(NumDossier, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstAddressInit = c.Row
wsCible.Cells(firstAddressInit, 38) = Marche
wsCible.Cells(firstAddressInit, 57) = produit
j = 0
While NumDossier = wsCible.Cells(firstAddressInit + j, 7)
wsCible.Cells(firstAddressInit + j, 38) = Marche
wsCible.Cells(firstAddressInit + j, 57) = produit
dateDebut = wsCible.Cells(firstAddressInit + j, 13).Value
datefin = wsCible.Cells(firstAddressInit + j, 14).Value
Montant_Encours = wsCible.Cells(firstAddressInit + j, 16).Value
Montant_EncoursApres = wsCible.Cells(firstAddressInit + j, 17).Value
If j = 0 Then
dateDebut = date_debut_Phase_Mob
Else
dateDebut = wsCible.Cells(firstAddressInit + j - 1, 14).Value
End If
If date_debut_Phase_Mob <= dateDebut And datefin <= date_Fin_Phase_Mob Then
wsCible.Cells(firstAddressInit + j, 29) = MargeClientCNU
wsCible.Cells(firstAddressInit + j, 30) = TMCCNU
wsCible.Cells(firstAddressInit + j, 31) = TCICNU
'wsCible.Cells(firstAddressInit + j, 15) = MontantEngagement
'wsCible.Cells(firstAddressInit + j, 18) = MontantEngagement - Montant_Encours
'wsCible.Cells(firstAddressInit + j, 20) = Montant_EncoursApres - Montant_Encours
'wsCible.Cells(firstAddressInit + j, 1) = "Mobilisation"
'wsCible.Cells(firstAddressInit + j, 13) = dateDebut
Else
'wsCible.Cells(firstAddressInit + j, 1) = "Amortissement"
wsCible.Cells(firstAddressInit + j, 29) = ""
wsCible.Cells(firstAddressInit + j, 30) = ""
wsCible.Cells(firstAddressInit + j, 31) = ""
End If
j = j + 1
Wend
End If
Next
wbSource.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Subbonjour
j'ai pas tout compris dans le code car il manque un fichier pour vérifier le tout mais voici en gros quelques explications
oui les ' met en commentaire la ligne
mes commentaires commencent par '******
fred
Sub recuperation_DonneesComplemenataireARKEA()
Application.ScreenUpdating = False
'*****definition de variables
Set wbCible = ThisWorkbook
Set wsCible = Worksheets("Données")
'***** effacement des colonnes 38,31 et 57 de la ligne 2 à 500000 de la feuille données
wsCible.Activate
Range(Cells(2, 38), Cells(500000, 38)).Select
Selection.ClearContents
Range(Cells(2, 57), Cells(500000, 57)).Select
Selection.ClearContents
Range(Cells(2, 29), Cells(500000, 31)).Select
Selection.ClearContents
'***** ouverture de la boite de dialogue pour que l'utilisateur choissise un fihcier
sFichier = Application.GetOpenFilename(, , "Sélectionnez le fichier")
'***** test si un fichier a été renseigné si oui ouverture sinon on quitte
If sFichier = False Then
Exit Sub
Else
Workbooks.Open Filename:=sFichier
Set wbSource = ActiveWorkbook
End If
'*****détermine la derniere ligne occupée sur la colonne B de la feuille fichier TCI
Application.DisplayAlerts = False
wbSource.Sheets("Fichier TCI").Activate
Range("B1").Select
Selection.End(xlDown).Select
nbLigne = Selection.Row
'***** on va parcourir toutes les lignes du fichier precedemment ouvert
For i = 2 To nbLigne
'***** met en mémoire dans des variables différentes infirmations de la ligne en cours de traitement
'*****.Cells(i, 3).Value => i ligne en cours 3 => colonne C
NumDossier = wbSource.Sheets("Fichier TCI").Cells(i, 3).Value
Marche = wbSource.Sheets("Fichier TCI").Cells(i, 5).Value
produit = wbSource.Sheets("Fichier TCI").Cells(i, 12).Value
MargeClientCNU = wbSource.Sheets("Fichier TCI").Cells(i, 6).Value
TCICNU = wbSource.Sheets("Fichier TCI").Cells(i, 7).Value
TMCCNU = wbSource.Sheets("Fichier TCI").Cells(i, 8).Value
'MontantEngagement = wbSource.Sheets("Fichier TCI").Cells(i, 9).Value
date_debut_Phase_Mob = wbSource.Sheets("Fichier TCI").Cells(i, 10).Value
date_Fin_Phase_Mob = wbSource.Sheets("Fichier TCI").Cells(i, 11).Value
'*****aller sur le fichier source et recherher la num dossier
wbCible.Activate
wsCible.Activate
Set ZoneNum = wsCible.Range(Cells(1, 7), Cells(500000, 7))
ZoneNum.Select
Set c = ZoneNum.Find(NumDossier, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'***** si le num de dossier est trouvé => déjà existant
If Not c Is Nothing Then
'***** copie les valeurs marche et produit dans les colonnes 38 et 57 du fichier source sur la ligne du num dossier trouvé
firstAddressInit = c.Row
wsCible.Cells(firstAddressInit, 38) = Marche
wsCible.Cells(firstAddressInit, 57) = produit
j = 0
'***** visiblement il doit y avoir plusieurs fois le num de dossier dans le fichier source et elle se trouvent les unes en dessous des autres et le nombre est variable. Donc tant qu'il y a le meme num de dossier on va repeter un certain nombre de choses
While NumDossier = wsCible.Cells(firstAddressInit + j, 7)
wsCible.Cells(firstAddressInit + j, 38) = Marche
wsCible.Cells(firstAddressInit + j, 57) = produit
dateDebut = wsCible.Cells(firstAddressInit + j, 13).Value
datefin = wsCible.Cells(firstAddressInit + j, 14).Value
Montant_Encours = wsCible.Cells(firstAddressInit + j, 16).Value
Montant_EncoursApres = wsCible.Cells(firstAddressInit + j, 17).Value
If j = 0 Then
'*****si c'est la premiere occurence du numdossier on attribue la date presente dansle fichier ouvert precedement
dateDebut = date_debut_Phase_Mob
Else
'***** si c'est les autres on recupere la date de debut ligne de dessus colonne 14
dateDebut = wsCible.Cells(firstAddressInit + j - 1, 14).Value
End If
'***** test sur les dates
If date_debut_Phase_Mob <= dateDebut And datefin <= date_Fin_Phase_Mob Then
'***** si condition realisée on met les infos du fichiers ouvert précédemment
wsCible.Cells(firstAddressInit + j, 29) = MargeClientCNU
wsCible.Cells(firstAddressInit + j, 30) = TMCCNU
wsCible.Cells(firstAddressInit + j, 31) = TCICNU
'wsCible.Cells(firstAddressInit + j, 15) = MontantEngagement
'wsCible.Cells(firstAddressInit + j, 18) = MontantEngagement - Montant_Encours
'wsCible.Cells(firstAddressInit + j, 20) = Montant_EncoursApres - Montant_Encours
'wsCible.Cells(firstAddressInit + j, 1) = "Mobilisation"
'wsCible.Cells(firstAddressInit + j, 13) = dateDebut
Else
'***** si condition non realisée on met rien ""
'wsCible.Cells(firstAddressInit + j, 1) = "Amortissement"
wsCible.Cells(firstAddressInit + j, 29) = ""
wsCible.Cells(firstAddressInit + j, 30) = ""
wsCible.Cells(firstAddressInit + j, 31) = ""
End If
'***** passage a la ligne suivante
j = j + 1
Wend
End If
Next
'***** fermture du fichier source
wbSource.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Subt
Ok super, j'investis le truc.
J'avais déjà compris la plupart du code mais quelques subtilités me manquaient.
t
C'est un taffe énorme que tu as fait, je crois que je vais pouvoir bidouiller un peu le code pour faire ce que je veux désormais.
Je reviens vers toi dans l'après-midi si mes ajouts ne fonctionnent pas.
Un énorme merci, vraiment !