RechercheV en VBA
Bonjour/Bonsoir :)
J'ai une feuille au format [ Vide | Date(jj/mm/aaaa hh:mm) | Pluie ].
Le but est, pour une date "début" et une date "fin", de récupérer la pluie entre ces deux dates. Puis de les copier coller ailleurs. Ici le ailleurs en question n'a pas d'importance, donc nous dirons par exemple de les coller à partir de la première ligne de la colonne E. Je vous glisse en PJ un beau dessin explicatif, et si jamais ça coince je mettrais directement le fichier xlsx.
Alors je ne sais pas s'il y a plus simple, mais j'ai pensé à utiliser la fonction RechercheV pour déterminer la cellule correspondant à "pluie_debut" à partir de ma date donné, faire de même pour déterminer ma cellule "pluie_fin", et faire un .copy avec Range entre les deux cellules.
J'ai vu qu'il y avait un tuto sur ce forum (je ne peux mettre le lien), mais j'ai un message d'erreur "impossible de lire la propriété Vlookup". J'ai donc essayé de passé par l'enregistreur de macro en simulant un test, mais ça a donné un truc incompréhensible. Je vous glisse également mon code actuel, si cela peut vous aider à mieux comprendre.
Si quelqu'un peut m'indiquer mes erreurs et m'aider à réaliser ceci, je vous serez très redevable !
CJ
Sub pluie()
Dim datedebut As String, datefin As String
Dim pluiedebut As Range, pluiefin As Range
Dim wbPluie As Workbook, wsPluie As Worksheet
'Neutraliser le rafraîchissement de l'écran et les messages d'erreur
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Chemin d'accès au fichier de la pluviométrie
Set wbPluie = Workbooks.Open(Cells(5, 3).Value)
Set wsPluie = wbPluie.Sheets("Horaire_initiale")
'INSTRUCTIONS
datedebut = "28/02/2016 16:00:00"
datefin = "28/03/2016 16:00:00"
'Resultat de l'enregirstreur de macro
'Sub Macro1()
'ActiveCell.FormulaR1C1 = _
' "=+VLOOKUP(RC[-8],'Tps marche 2P 1h'!C[-8]:C[-2],6,FALSE)"
'Range("I190668").Select
'End Sub
'Colonne B = Date, colonne C = l'info que je veux récupérer
Set pluidebut = Application.WorksheetFunction.VLookup(datedebut, wsPluie.Columns("B:C"), 2, False)
Set pluifin = Application.WorksheetFunction.VLookup(datefin, wsPluie.Columns("B:C"), 2, False)
wsPluie.Range(pluiedebut, pluifin).Copy wsPluie.Range("E:E")
wbPluie.Close SaveChanges:=True
' Réactiver le rafraîchissement de l'écran
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bonjour,
j'ai fait à ma façon.
En voyant Début et Fin sur ton image, j'ai cru que tu les inscrivais sur la feuille.
Il vaut mieux laisser une colonne vide entre des tableaux de données.
Sub extraire()
Dim lig As Long, nb As Long
lig = Cells(Rows.Count, "H").End(xlUp).Row
If lig > 1 Then [H2].Resize(lig).ClearContents
lig = Application.Match(CLng([G2].Value), [B:B], 1)
nb = Application.Match(CLng([G3].Value), [B:B], 1) - lig + 1
[H2].Resize(nb).Value = Cells(lig, "C").Resize(nb).Value
End Suberic
Bonjour Eric,
Merci beaucoup pour ton message. Je comprend le code dans sa globalité. Je vais essayer de l'appliquer à mon cas (copie d'un wb vers un autre), là où ça coince en général c'est de bien faire appel aux différents wb.ws.cell sans faire d'erreur de syntaxe.
La fonction que tu utilises
Application.Match(CLng([G2].Value), [B:B], 1)fonctionne t'elle d'un classeur à un autre ? Cad :
Application.Match(CLng(classeurX.FeuilleX.CellX.Value),classeurY.FeuilleY.CellY.Value, 1)Encore merci, je reviens vers toi très vite.
Bah essaie, mais plutôt écrit comme ça :
lig = Application.Match(CLng(workbooks("classeur1.xlsx").worksheets("feuil1").[G2].Value), workbooks("classeur2.xlsx").worksheets("feuil1")[B:B], 1)
Re, c'est bon tout fonctionne très bien d'un classeur à un autre.
En résolvant ce problème, j'en soulève un autre beaucoup plus gros, les lacunes. Du coup, passer par un copier/coller entre une date début et une date de fin comme nous venons de le faire ne fonctionne pas. Peut-être qu'il existe une fonction excel qui permet automatiquement de reporter des valeurs en fonction de dates, mais je n'en ai pas la connaissance. Du coup, j'ai fais le logigramme suivant avec des commentaires pour les détails :
Sub testdepluie()
debut = wsFinal.madatededebut
fin = wsFinal.madatedefin
'la dernière cellule à remplir/reporter serait donc :
LastCell = wsFinal.Range(fin, colonne[C] )
While LastCell = cellule vide
'Parcours de chaque date dans le fichier pluie
For Each date1 In Range(wsPluie.debut, wsPluie.fin)
'Parcours de chaque date dans le fichier final (destination)
For Each date2 In Range(wsFinal.debut, wsFinal.fin)
If date1 = date2 Then 'si les dates correspondent, on reporte la valeur
wsPluie.range(date1,colonne[C]).Copy wsFinal.range(date2,colonne[C])
ElseIf date1 > date2 Then 'lacune sur les données de pluie
While date1 <> date2 'tant que les 2 dates ne sont pas identiques
wsFinal.range(date2,colonne[C]) = NA
Next date2
Loop
ElseIf date2 > date1 Then 'lacune sur les données de débit, inutile d'y associer une donnée de pluie
While date1 <> date2 'tant que les 2 dates ne sont pas identiques
Next date1
Loop
End If
Next date2
Next date1
Loop
End SubSachant que j'ai à peu près 30 000 lignes de dates dans mon fichier, et une dizaine de fichiers à traiter, est-ce que ce serait beaucoup trop lourd d'effectuer une vérification comme celle-ci à chaque ligne ? Je vais essayer de retranscrire ça en code VBA, en attendant que penses-tu de cette logique ? Vois-tu quelque chose de plus simple à faire ?
CJ
Parcourir chaque cellules des feuilles est très lent et pas très efficace, ce n'est pas le choix que j'avais fait.
Je te laisse continuer sans moi dans cette voie.
eric