Tri dates et heures dans un tableau

Version imprimable

08/01/2017, 14h19
Greg57365

1 pièce(s) jointe(s)

Tri dates et heures dans un tableau

Bonjour,

En vue de réaliser un graphique à partir d'un tableau, j'ai besoin de supprimer des lignes de mon tableau à partir du remplissage d'un formulaire. Je m'explique :

En colonne A de ma feuille Excel, j'ai des dates de la forme JJ/MM/AAAA.
En B, j'ai des heures:minutes:secondes

Vous trouverez en fichier joint le type de tableau décrit (j'ai gardé dans ce fichier uniquement les colonnes A et B qui nous sont utiles, les autres étant confidentielles).

Dans mon Userform, l'utilisateur sélectionnes une date de début et une date de fin (avec les heures et minutes). J'aimerais que ma macro supprime lors du clic sur le bouton "valider" de mon Userform les lignes de mon tableau dont la date ou l'heure ne se situe pas dans la plage sélectionnée dans le formulaire.

De plus, les secondes ne sont pas à prendre en compte mais les cellules de la colonnes B les affichent, je ne sais pas comment en faire abstraction dans le code.

Quelqu'un aurait-il une solution ? J'ai pensé à une boucle For qui varie de 2 au nombre total de ligne pour ne garder que le jour voulu et une recherche "Find" des heures/minutes pour ne garder que la plage souhaitée. Je pense que cette méthode rend l'exécution du programme trop lente.

Merci d'avance pour votre aide, vous comprendrez certainement mieux en jetant un œil au fichier joint.

Greg

Citation:

Envoyé par Greg57365

Quelqu'un aurait-il une solution ? J

Bonjour,

Vous pourriez faire votre graphique directement depuis un filtre avancé.

Pièce jointe 232895

Le bouton de l'onglet Résultat filtre lance la macro suivante :
Code:

1 2 3 4 5 6 7 Sub FiltrerLesDonnees() Range("'Données'!Data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "'Résultat filtre'!Criteria"), CopyToRange:=Range("'Résultat filtre'!Extract"), Unique:=False End Sub
Pièce jointe 232899

Regardez le tuto de Philippe TULLIEZ advancedfilter

Bonsoir,

Outre la solution du filtre proposée par Eric, voici un code qui répond à la demande (à l'exception prêt que j'ai masqué les ligne... je ne les ai pas supprimées (adapter le code en conséquence...

Code:

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
40
41
42
43
44
45
46
47
48
49
Private Sub CommandButton1_Click()
  Dim i As Long
  Dim lMin As Long
  Dim lMax As Long
  Application.ScreenUpdating = False
'On assure le coup au cas où !... trier les dates et Heures
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "A2:A14834"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "B2:B14834"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:B14834")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'============================================
  Range("A1").EntireRow.Hidden = False
  For i = Range("A1048576").End(xlUp).Row To 1 Step -1
    Application.StatusBar = "Analyse ligne " & i
    If i > 1 Then
      If Cells(i, 1) + VBA.Hour(Cells(i, 2)) / 24 + VBA.Minute(Cells(i, 2)) / (24 * 60) > _
        VBA.DateSerial(VBA.Year(Range("A2")), VBA.Month(Range("A2")), CLng(Me.ComboBox4.Text)) + _
        VBA.CLng(Me.ComboBox5) / 24 + VBA.CLng(Me.ComboBox6) / (24 * 60) Then
 
        lMax = i - 1
      End If
      If Cells(i, 1) + VBA.Hour(Cells(i, 2)) / 24 + VBA.Minute(Cells(i, 2)) / (24 * 60) < _
      VBA.DateSerial(VBA.Year(Range("A2")), VBA.Month(Range("A2")), CLng(Me.ComboBox1.Text)) + _
      VBA.CLng(Me.ComboBox2) / 24 + VBA.CLng(Me.ComboBox3) / (24 * 60) Then
 
        lMin = i
        Exit For
      End If
    End If
  Next
  MsgBox "Min " & lMin & " - Max " & lMax
  If lMin > 2 Then
    Range("A2:A" & lMin - 1).EntireRow.Hidden = True
  End If
  Range("A" & lMax + 1 & ":A" & Range("A1").CurrentRegion.Rows.Count).EntireRow.Hidden = True
Application.StatusBar = False
 
End Sub

09/01/2017, 20h44
Greg57365

Bonsoir,

En utilisant le fichier de ERBAG, c'est exactement ce qu'il me faut, mise à part le fait de rendre les lignes invisibles au lieu de les supprimer. Un grand merci à toi !!

Par contre, lorsque je modifie le code "Entirerow.hidden = True" en "EntireRow.Delete", certaines lignes non souhaitées ne se suppriment pas, je ne comprends pas pourquoi puisque les calculs du programme n'ont pas été modifiés...

Y-a-t-il quelque chose que je n'ai pas saisi avec la propriété "Delete" ??

Merci,

Greg