Discussion :

[debutante_anonyme]

Bonjour,

Je suis debutante sur VBA et j'aimerais effectuer une recherche verticale sur la colonne A de plusieurs feuilles puis recuperer la ligne correspondante de chaque feuille et la coller dans ma feuille "Bilan" mais je n'arrive pas a ecrire mon code.

Voici mon probleme :

J'ai 5 feuilles a trier qui presentent la meme structure :

- colonne A : date au format JJ/MM/AAAA (valeurs deja triees)
- colonne B : l'heure
- colonne C : temperature
- colonne D : profondeur (mais cette colonne n'est pas importante)

Ces differentes feuilles n'ont pas le meme nombre de donnees, j'aimerais donc rechercher les dates communes de ces 4 feuilles afin de recuperer l'heure et la temperature correspondantes de chaque feuille, et les recopier dans une nouvelle feuille que l'on peut nommer "Bilan".

Cependant, je ne sais pas du tout par ou commencer cette recherche verticale puisque je sens qu'il y aura des sous boucles, et je fais alors appel a votre aide. Je vous joins un exemple de fichier pour mieux visualiser mon probleme : fichier_modele.xlsx
Pourriez-vous m'aider s'il vous plait?

J'espere avoir expose clairement mon probleme.

Merci d'avance!

Sab

[anasecu]

Bonjour,

J'espere avoir expose clairement mon probleme.

Si je l'ai bien compris, je te propose cette macro, mais il faut que sur ta ligne 4 du bilan la dernière colonne ait le même nom que la feuille correspondante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Sub Bilan()
Dim col As Byte, wb As Worksheet
Dim cel As Range, lgb As Long, lgo As Long
Application.ScreenUpdating = False
Set wb = Worksheets("Bilan")
For col = 2 To 10 Step 2
    With Worksheets(wb.Cells(4, col).Value)
        For lgo = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            Set cel = wb.Columns(1).Find(.Cells(lgo, 1), [A1])
            If cel Is Nothing Then
                lgb = wb.Cells(Rows.Count, 1).End(xlUp).Row + 1
                wb.Cells(lgb, 1).Value = .Cells(lgo, 1).Value
            Else
                lgb = cel.Row
            End If
            wb.Cells(lgb, col).Value = .Cells(lgo, 2).Value
            wb.Cells(lgb, col + 1).Value = .Cells(lgo, 3).Value
        Next lgo
    End With
Next col
Application.ScreenUpdating = True
End Sub

[debutante_anonyme]

Bonjour,

Merci beaucoup pour ton aide, je ne pourrai tester ça que lundi prochain au bureau!

J'avais fait des recherches et j'avais vu qu'il était possible de faire ce que je voulais en utilisant l'objet Dictionary. Mais ta méthode a l'air beaucoup plus simple, je me pencherai là-dessus lundi

[anasecu]

Bonjour,

j'avais vu qu'il était possible de faire ce que je voulais en utilisant l'objet Dictionary

Pas sûr que ce soit très adapté pour regrouper 4 feuilles ?

[debutante_anonyme]

Bonjour,

J'ai teste la macro et elle semble faire ce que je souhaite mais lorsque je la lance sur mon fichier final, elle bug... Quand le programme atteint la date finale, il semble recommencer. Est-ce a cause de la 1ere boucle For?
Voici ce que j'obtiens : modele_VBA_test_v2.xlsm
Ici la feuille "Bilan" s'appelle "DataToAnalyze" et il faut d'abord faire tourner le module "Import_Data" (je joins un fichier type : NIWA-Raw.xlsx) avant de lancer "Sort_Data"


Pour obtenir ce que je souhaite, il me suffit maintenant de supprimer les lignes de mon tableau presentant une cellule vide ou un tiret (-). Peut-on tout faire en une seule fois ou l'etape decrite par ton programme est-elle necessaire et/ou plus simple?

Merci encore pour ta proposition

[anasecu]

Bonjour,

lorsque je la lance sur mon fichier final, elle bug... Quand le programme atteint la date finale, il semble recommencer.

Personnellement je n'ai pas de bug mais regardes plutôt dans tes ajouts.

[debutante_anonyme]

regardes plutôt dans tes ajouts.

C'est a dire? haha
Dans mes Add-Ins, je n'ai rien de coche.

Sinon, pour palier mon probleme, j'ai ajoute une autre boucle pour supprimer les lignes indesirables. Peux-tu me dire ce que tu en penses? modele_VBA_test_v3.xlsm Je ne sais pas si le programme risque d'etre trop lourd.

Bonne soiree.

[anasecu]

Bonjour,

j'ai ajoute une autre boucle pour supprimer les lignes indesirables. Peux-tu me dire ce que tu en penses?

Lorsque tu supprimes la ligne il faut sortir de la boucle colonne car après, tu n'es plus sur la bonne ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

            Rows(i).Delete: Exit for

[debutante_anonyme]

Bonjour,

Le programme semble faire ce que je veux mais si je rajoute Exit For, toutes mes lignes sont supprimees.

[Klin89]

Bonsoir debutante_anonyme,

Tu peux tester ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
Sub test()
Dim a, w(), i As Long, col As Byte
Dim Sl As Object, ws As Worksheet
    Set Sl = CreateObject("System.Collections.SortedList")
    col = 0
    For Each ws In Worksheets([{"10cm","20cm","50cm","100cm","Tmax, Tmin, Tgmin"}])
        a = ws.Range("A1").CurrentRegion.Value2
        col = col + 2
        For i = 2 To UBound(a, 1)
            If Not Sl.Contains(a(i, 1)) Then
                ReDim w(1 To 13)
                w(1) = a(i, 1)
            Else
                w = Sl(a(i, 1))
            End If
            w(col) = a(i, 2): w(col + 1) = a(i, 3)
            If ws.Name = "Tmax, Tmin, Tgmin" Then
                w(col + 2) = a(i, 4): w(col + 3) = a(i, 5)
            End If
            Sl(a(i, 1)) = w
        Next
    Next
    With Sheets("Bilan")
        With .Range("a4").CurrentRegion.Offset(2)
            .ClearContents
            With .Resize(Sl.Count)
                .Columns(1).NumberFormat = "dd/mm/yyyy"
                For col = 2 To 10 Step 2
                    .Columns(col).NumberFormat = "h:mm"
                Next
            End With
        End With
        For i = 0 To Sl.Count - 1
            .Rows(i + 6).Value = Sl.GetByIndex(i)
        Next
    End With
    Set Sl = Nothing
End Sub

klin89