Discussion :

[drakkar_agfa]

Bonjour,

J'utilise le Sort pour faire des tries. En général tout va bien jusqu'au moment de trier une feuille mais avec 4 critères... Est-ce qu'il a un moyen de rajouter des critères.....

Voici l'aide :

Code :

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

expression.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

Je ne peux pas ajouter une Key4....

Merci de votre aide!

[fring]

Bonjour,

A ma connaissance Sort n'accepte pas plus de 3 critères mais rien ne t'empêche de le faire en 2x en commençant d'abord par le tri sur le 4 ème critère et ensuite de faire le tri sur les critères 1, 2 et 3.

Cdlt

[cafeine]

Hello,

pour utiliser 4 critères, on peut se servir de SQL.

[drakkar_agfa]

Merci fring,

j'utilisais déja la technique parce qu'en fait, j'aurais 5 critères, et le premier était déja fait. C'est moins pratique mais je vais utiliser cette technique la.


Et pour la SQL, je n'ai aucune expérience, en fait... j'ai jamais vu.
À moins que ce soit facile et applicable au code VBA...

Merci!

[cafeine]

Ok, voici une implémentation de SQL qui utilise 4 critères de tri :

et le code (à lettre dans un module) :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Sub RefreshSQL()
 
Dim res As Range
Dim firstAddress As String
 
    With ActiveSheet.Cells
        Set res = .Find(What:="RUNSQL", After:=ActiveCell, LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                'Debug.Print res.Address, res.Value
                If res.Value Like "RUNSQL:SOURCE=*" Then
                    ' exécution du SQL
                    Dim db As Object, dbEng As Object, rec As Object
                    Dim txtSource As String, txtTarget As String
                    Dim txtSQL As String, chkTitre As String, sSQL As String
                    Dim rt As Range, rs As Range
 
                    txtSource = Split(Split(res.Value, "SOURCE=")(1), ";TITRE=")(0)
                    chkTitre = CInt(Split(Split(res.Value, "TITRE=")(1), ";CMD=")(0))
                    txtSQL = Split(res.Value, ";CMD=")(1)
                    Set rs = Range(txtSource)
                    Set rt = res.Offset(1, 0)
 
                    Set dbEng = CreateObject("DAO.DBEngine.36")
                    Set db = dbEng.Workspaces(0).OpenDatabase(rs.Parent.Parent.FullName, _
                                              False, _
                                              False, _
                                              "Excel 8.0;HDR=" & _
                                    IIf(chkTitre = True, "YES", "NO") & ";")
 
                    sSQL = Replace(txtSQL, "<Table>", "[" & rs.Parent.Name & "$" & rs.Address(False, False, xlA1) & "]")
                    Set rec = db.OpenRecordset(sSQL, 4)
                    rt.CopyFromRecordset rec
                    rec.Close
 
                    Set dbEng = Nothing
                    Set db = Nothing
                    Set rs = Nothing
 
                End If
                Set res = .Find(What:="RUNSQL", After:=res, LookIn:=xlFormulas _
                        , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With
 
Set res = Nothing
 
End Sub

[drakkar_agfa]

Merci pour ton code, en attendant j'ai utiliser plusieurs tries de suite.

Mais je prendrai le temps d'essayer de comprendre cette macro avec le SQL.

Pour l'instant je n'ai pas le temps, mais j'ai quand même appuyé sur le bouton
Il me donne un erreur 1004 avec la ligne de code : Set rs = Range(txtSource)

J'ai aucune idée c'est quoi l'erreur, je n'ai pas réellement regardé le code, et ce n'est pas grave si je n'ai pas de réponse pour l'instant.