IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Correction d’un code


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut Correction d’un code
    Bonsoir à tous,

    Pour cette première phase de comptage, j’ai en colonne A, des chiffres triés, allant de 0 à 12000.

    En colonne I, j’ai un tableau d’intitulés, et en colonne J les ensembles affectées à ces intitulés.

    Intitulé Ensemble
    TT [0-5]
    TT [6-8]
    ZYR [9-15]
    SRG [16-21]
    SRG [30-52]
    FDR [22-25]

    Les ensembles sont sous forme de [x-y] (Commence à x et se termine par y).

    Alors en colonne C, j’aimerais mettre seulement les ensembles qui ont leurs valeurs dans la colonne A.

    En colonne D, le total des valeurs trouvées de chaque ensemble dans la colonne A.

    Par exemple :

    En colonne A :
    0
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11

    En colonne C (Ensemble) et D (Total), on devra avoir :

    Ensemble Total
    [0-5] 6
    [6-9] 4
    [10-25] 2

    Mais voila le code suivant, compte bien ces totaux, mais ne les affiche pas dans la colonne D.

    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
    57
    58
    59
    Sub CompteOccu()
        Dim dl As Long    'déclare la variable dl (Dernière Ligne)
        Dim pl As Range    'déclare la variable pl (PLage)
        Dim dico As Object    'déclare la variable dico (DICtiOnnaire)
        Dim Cel As Range, Cel2 As Range   'déclare la variable cel (CELLule)
        Dim temp As Variant    'déclare la variable temp (tableau TEMPoraire)
        Dim Ens() As String, Min As Integer, Max As Integer, Cpt As Integer
        Dim x As Integer, y As Integer
        Application.ScreenUpdating = False
        Set dico = CreateObject("Scripting.Dictionary")    'définit le dictionnaire dico
        With Sheets("Feuil1")    'prend en compte l'onglet "Feuil1"
            .Cells(3, 4).CurrentRegion.ClearContents    'efface les anciennes données
     
            dl = .Cells(Application.Rows.Count, 10).End(xlUp).Row    'définit la dernière ligne dl de la colonne B
            Set pl = .Range("J2:J" & dl)    'définit la plage pl
            For Each Cel In pl    'boucle sur toutes les cellules cel de la plage pl
            'MsgBox "Cel Ens = " & Cel
                Ens = Split(Cel, "-")
                Min = Mid(Ens(0), 2): Max = Mid(Ens(1), 1, Len(Ens(1)) - 1)
                '-- Nombre de valeur max à trouver
                Cpt = (Max - Min) + 1: y = 1
                For Each Cel2 In .Range("A2:A13000")
                    If Cel2 >= Min And Cel2 <= Max Then
                        dico(Cel) = dico(Cel) + 1  'alimente le dictionnaire
                        y = y + 1
                   ElseIf y > Cpt Then
                        Exit For
                    End If
                Next Cel2
            Next Cel    'prochaine cellule de la boucle
            temp = dico.keys    'récupère le dictionnaire sans doublons
            Call Tri(temp, LBound(temp), UBound(temp))    'lance la procédure de tri croissant du tableau temp
            [C1] = "Ensemble": [D1] = "Total"
            For x = 0 To UBound(temp)    'boucle sur tous les éléments du tableau tri
                .Cells(x + 2, 3).Value = temp(x)     'place l'étiquette
                .Cells(x + 2, 4).Formula = dico.Item(temp(x)) 'place le total résultant
            Next x    'prochain élément de la boucle
        End With    'fin de la prise en compte de l'onglet "BDD"
        Application.ScreenUpdating = True
    End Sub
     
    Sub Tri(a As Variant, gauc As Integer, droi As Integer)    'tiré du site de Jacques BOISGONTIER http://boisgontierjacques.free.fr/
        Dim ref As Variant
        Dim g As Integer, d As Integer
        Dim tmp As Variant
     
        ref = a((gauc + droi) \ 2)
        g = gauc: d = droi
        Do
            Do While a(g) < ref: g = g + 1: Loop
            Do While ref < a(d): d = d - 1: Loop
            If g <= d Then
                tmp = a(g): a(g) = a(d): a(d) = tmp
                g = g + 1: d = d - 1
            End If
        Loop While g <= d
        If g < droi Then Call Tri(a, g, droi)
        If gauc < d Then Call Tri(a, gauc, d)
    End Sub
    Merci d'avance.

  2. #2
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut
    Bonsoir,

    On supprimmant cette ligne, les valeur seront affichées :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Call Tri(temp, LBound(temp), UBound(temp))    'lance la procédure de tri croissant du tableau temp
    Pourquoi, je ne sais pas !!!

    En plus le tri croissant, n'est pas bien fait.

    Au lieu d'avoir :

    [0-5]
    [6-8]
    [9-15]
    [16-21]
    [22-25]
    [30-52]

    J'ai :

    [0-5]
    [16-21]
    [22-25]
    [30-52]
    [6-8]
    [9-15]


  3. #3
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 166
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 166
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Le tri est correct parce-que c'est une chaîne de caractères et pas un nombre.
    Dans une chaîne de caractères [600] est plus grand que [1000]
    D'ailleurs si tu places des nombres dans une colonne A, que tu les copies en colonne D en les convertissant en caractères et que tu fais un tri sur les 2 colonnes séparément tu constateras par toi même la différence.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Une autre approche
    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
    Sub CompteOccurences()
    Dim Tb As Range, c As Range
    Dim Plage As String
    Dim i As Long
    Dim Tmp
     
    Application.ScreenUpdating = False
    With Worksheets("Feuil1")
        Set Tb = .Range("J2", .Cells(.Rows.Count, "J").End(xlUp))
        Tb.Offset(0, 1).ClearContents
        Plage = "$A$2:" & .Cells(.Rows.Count, "A").End(xlUp).Address
        For Each c In Tb
            Tmp = Extrema(c)
            If IsArray(Tmp) Then
                With c.Offset(0, 1)
                    .Formula = "=SUMPRODUCT((" & Plage & ">=" & Tmp(0) & ")*(" & Plage & "<=" & Tmp(1) & ")*1)"
                    .Value = .Value
                End With
                c.Offset(0, 2) = Tmp(0)
            End If
        Next c
        Tb.Resize(, 3).Sort Key1:=Tb.Offset(0, 2).Resize(1, 1), Order1:=xlAscending, Header:=xlNo
        Tb.Offset(0, 2).ClearContents
        Set Tb = Nothing
    End With
    End Sub
     
    Private Function Extrema(ByVal Str As String)
     
    Str = Replace(Str, "[", "")
    Str = Replace(Str, "]", "")
    If InStr(Str, "-") Then Extrema = Split(Str, "-")
    End Function

  5. #5
    apt
    apt est déconnecté
    Membre éclairé
    Inscrit en
    Mai 2002
    Messages
    867
    Détails du profil
    Informations forums :
    Inscription : Mai 2002
    Messages : 867
    Par défaut
    Bonsoir corona, mercatog,

    Merci pour réponses.

    J'ai adapté le code pour qu'il soit ainsi :


    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
    Sub CompteOccurences()
        Dim Tb As Range, C As Range
        Dim Plage As String
        Dim i As Long
        Dim Tmp
     
        Application.ScreenUpdating = False
        With Worksheets("Feuil1")
            Set Tb = .Range("J2", .Cells(.Rows.Count, "J").End(xlUp))
            Tb.Offset(0, -5).ClearContents
            Plage = "$A$2:" & .Cells(.Rows.Count, "A").End(xlUp).Address
            For Each C In Tb
                Tmp = Extrema(C)
                If IsArray(Tmp) Then
                    'With c.Offset(0, 1)
                    C.Offset(0, -7).Value = C
                    With C.Offset(0, -6)    ' Colonne C
                        .Formula = "=SUMPRODUCT((" & Plage & ">=" & Tmp(0) & ")*(" & Plage & "<=" & Tmp(1) & ")*1)"
                        .Value = .Value
                    End With
                    'c.Offset(0, 2) = Tmp(0)
                    C.Offset(0, -5) = Tmp(0)
                End If
            Next C
            'Tb.Resize(, 3).Sort Key1:=Tb.Offset(0, 2).Resize(1, 1), Order1:=xlAscending, Header:=xlNo
            'Tb.Offset(0, 2).ClearContents
            Tb.Offset(0, -7).Resize(, 3).Sort Key1:=Tb.Offset(0, -5).Resize(1, 1), Order1:=xlAscending, Header:=xlNo
            Tb.Offset(0, -5).ClearContents
     
            Set Tb = Nothing
        End With
    End Sub
    Une modification ?

    Merci.

Discussions similaires

  1. Réponses: 6
    Dernier message: 19/07/2007, 12h30
  2. [VBA-E] Amelioration dun code
    Par Elstak dans le forum Macros et VBA Excel
    Réponses: 28
    Dernier message: 06/06/2007, 13h51
  3. Correction du code
    Par punisher999 dans le forum Langage
    Réponses: 8
    Dernier message: 28/01/2007, 21h26

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo