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
photo

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 Sub

eric

48pluvio-exemple.xlsm (34.10 Ko)

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 Sub

Sachant 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

21exemple-wbfinal.zip (622.96 Ko)
23exemple-wbpluie.zip (659.68 Ko)

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

Rechercher des sujets similaires à "recherchev vba"