Aide sur une macro existante
Hello,
Dans un autre forum, j'ai pu obtenir de l'aide sur la création d'une macro. La macro fonctionne correctement.
Le problème est qu'une des étapes de la macro ne donne pas le résultat escompté et que je ne parviens pas à trouver une solution.
L'objectif de cette macro est, entre autres, appliquer un "filtre" sur base de la date la plus éloignée. Actuellement, elle me donne l'inverse, c'est à dire qu'elle choisit la date la plus proche.
Est-ce que quelqu'un aurait la gentillesse d'y jeter un coup d'oeil et de m'indiquer quel paramètre je devrais changer?
D'avance un grand merci.
PS : c'est un topic initialement posté sur forum excel pratique et la macro a été créé par MFerrand (tous les crédits lui reviennent :)).
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
| Sub FiltrerListe()
Dim tbl(), dpt, itm, aa, i%, d As Object, ok As Boolean
Set d = CreateObject("Scripting.Dictionary")
aa = ActiveSheet.Range("A1").CurrentRegion.Value2
For i = 2 To UBound(aa)
dpt = aa(i, 1)
If d.exists(dpt) Then
itm = Split(d(dpt), ";")
If aa(i, 3) < CInt(itm(1)) Then
ok = True
ElseIf aa(i, 4) < CLng(itm(2)) Then
ok = True
End If
If ok Then
itm = aa(i, 2) & ";" & aa(i, 3) & ";" & aa(i, 4)
d(dpt) = itm: ok = False
End If
Else
itm = aa(i, 2) & ";" & aa(i, 3) & ";" & aa(i, 4)
d(dpt) = itm
End If
Next i
ReDim tbl(d.Count, 3): i = 0
For Each dpt In d.keys
itm = Split(d(dpt), ";")
i = i + 1: tbl(i, 0) = dpt: tbl(i, 1) = itm(0)
tbl(i, 2) = CInt(itm(1)): tbl(i, 3) = CLng(itm(2))
Next dpt
itm = Split("Département Décision Phase Date")
For i = 0 To 3
tbl(0, i) = itm(i)
Next i
Application.ScreenUpdating = False
With ActiveSheet.Range("J1").Resize(UBound(tbl, 1) + 1, 4)
.Value = tbl
With .Rows(1)
.HorizontalAlignment = xlCenter: .Font.Italic = True
End With
.Columns(4).NumberFormat = "dd/mm/yyyy"
.Columns.AutoFit
End With
End Sub |
