Probleme Tri automatique avec VBA

oliv

XLDnaute Nouveau
Bonjour,
je reviens vers vous en ce moment décisif...
Non en fait j ai un ptit probleme: j ai fait une macro avec l'enregistreur de macro, n'ayant aucune idée comment écrire le code vba pour un tri sur couleur. J'ai une colonne dans laquelle se trouve des variables de médailles "Or",Argent,Bronze avec une couleur chacune. Je voudrais les trier d'or a bronze. Malheureusement quand j insere ma macro dans le code VBA de mon bouton déclencheur de déja beaucoup de choses, il y a 6 lignes qui ne sont pas prises en compte...

quelqu'un détecterait un probleme dans ce code? :

Private Sub CommandButton1_Click()
Dim i&, j&
Dim Tableau()
ReDim Tableau(1 To 5, 1 To 1)


Worksheets("Résultat").Range("A11:E65536").Cells.Clear


With Sheets("Inscr.")
For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
For j = 20 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j).Value = "x" Then
ReDim Preserve Tableau(1 To 5, 1 To UBound(Tableau, 2) + 1)
Tableau(1, UBound(Tableau, 2)) = .Cells(i, 4)
Tableau(2, UBound(Tableau, 2)) = .Cells(i, 5)
Tableau(3, UBound(Tableau, 2)) = .Cells(i, 6)
Tableau(4, UBound(Tableau, 2)) = .Cells(1, j).Value
If .Cells(i, j + 1).Value = "" Then
Tableau(5, UBound(Tableau, 2)) = "Participation"
Else
Tableau(5, UBound(Tableau, 2)) = .Cells(i, j + 1).Value
End If
End If
Next j
Next i
End With



Cells(10, 1).Resize(UBound(Tableau, 2), UBound(Tableau, 1)) = Application.Transpose(Tableau)

Worksheets("Résultat").Cells.Columns.AutoFit
Worksheets("Résultat").Range("C11:C65536").HorizontalAlignment = xlCenter
Worksheets("Résultat").Range("C11:C65536").NumberFormat = "0#"


For Each Cell In Worksheets("Résultat").Range("E11:E65536")
If Cell.Value = "Arg" Or Cell.Value = "Argent" Or Cell.Value = "ARG" Then
Cell.Interior.ColorIndex = 15
End If
Next
For Each Cell In Worksheets("Résultat").Range("E11:E65536")
If Cell.Value = "Or" Or Cell.Value = "OR" Then
Cell.Interior.ColorIndex = 44
End If
Next
For Each Cell In Worksheets("Résultat").Range("E11:E65536")
If Cell.Value = "Bro" Or Cell.Value = "Bronze" Or Cell.Value = "BRO" Then
Cell.Interior.ColorIndex = 40
End If
Next

ActiveWorkbook.Worksheets("Résultat").AutoFilter.Sort.SortFields.Add(Range( _
"E1:E607"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(255, 204, 0)
ActiveWorkbook.Worksheets("Résultat").AutoFilter.Sort.SortFields.Add(Range( _
"E1:E607"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(192, 192, 192)
ActiveWorkbook.Worksheets("Résultat").AutoFilter.Sort.SortFields.Add(Range( _
"E1:E607"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(255, 204, 153)
With ActiveWorkbook.Worksheets("Résultat").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub


Bonne journée et merci d'avance pour les réponses
 

mutzik

XLDnaute Barbatruc
Re : Probleme Tri automatique avec VBA

re,

ton classeur en retour
par principe, je fais toujours des macros séparées que j'appelle ensuite dans un module général
cela permet de faire un débogage plus rapide
par ex
sub principale
redim_tableau
couleur
tri_MEDAILLES
end sub

il faut juste donner le nom de la macro à exécuter, elles s'enchainent à la suite
 

Pièces jointes

  • xld.xlsm
    14.6 KB · Affichages: 91
  • xld.xlsm
    14.6 KB · Affichages: 88
  • xld.xlsm
    14.6 KB · Affichages: 90
Dernière édition:

oliv

XLDnaute Nouveau
Re : Probleme Tri automatique avec VBA

Re,
alors oui merci pour la correction de ma méthode de travail, je vais essayer a l avenir d etre plus structuré.
Par contre, c'est bien joli tout ca, mais chez moi j ai toujours le meme probleme... Je pense que ca a peut etre un rapport avec le bouton Actualiser. Je préfèrerai qu on m'aide sur cela et non que l on modifie mon probleme... Je viens de restructurer comme tu l'as fait, ca ne change rien... Par contre tu as pris le soin de retirer tout, sauf la couleur et le tri, c est certainement pour ca que dans ta version tout marche bien..

Merci quand meme
 

pierrejean

XLDnaute Barbatruc
Re : Probleme Tri automatique avec VBA

bonsoir

En l'absence de Bertrand

Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i&, j&
Dim Tableau()
ReDim Tableau(1 To 5, 1 To 1)
Worksheets("Résultat").Range("A11:E65536").Cells.Clear
With Sheets("Inscr.")
    For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
        For j = 20 To .Cells(1, Columns.Count).End(xlToLeft).Column
            If .Cells(i, j).Value = "x" Then
                ReDim Preserve Tableau(1 To 5, 1 To UBound(Tableau, 2) + 1)
                Tableau(1, UBound(Tableau, 2)) = .Cells(i, 4)
                Tableau(2, UBound(Tableau, 2)) = .Cells(i, 5)
                Tableau(3, UBound(Tableau, 2)) = .Cells(i, 6)
                Tableau(4, UBound(Tableau, 2)) = .Cells(1, j).Value
                If .Cells(i, j + 1).Value = "" Then
                    Tableau(5, UBound(Tableau, 2)) = "Participation"
                Else
                    Tableau(5, UBound(Tableau, 2)) = .Cells(i, j + 1).Value
                End If
            End If
        Next j
    Next i
End With
Cells(10, 1).Resize(UBound(Tableau, 2), UBound(Tableau, 1)) = Application.Transpose(Tableau)
Worksheets("Résultat").Cells.Columns.AutoFit
Worksheets("Résultat").Range("C11:C65536").HorizontalAlignment = xlCenter
Worksheets("Résultat").Range("C11:C65536").NumberFormat = "0#"
derlin = Worksheets("Résultat").Range("E65536").End(xlUp).Row
For Each Cell In Worksheets("Résultat").Range("E11:E" & derlin)
   If Cell.Value = "Arg" Or Cell.Value = "Argent" Or Cell.Value = "ARG" Then
      Cell.Interior.ColorIndex = 15
   End If
Next
For Each Cell In Worksheets("Résultat").Range("E11:E" & derlin)
   If Cell.Value = "Or" Or Cell.Value = "OR" Then
      Cell.Interior.ColorIndex = 44
   End If
Next
For Each Cell In Worksheets("Résultat").Range("E11:E" & derlin)
   If Cell.Value = "Bro" Or Cell.Value = "Bronze" Or Cell.Value = "BRO" Then
      Cell.Interior.ColorIndex = 40
   End If
Next
    ActiveWorkbook.Worksheets("Résultat").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Résultat").Sort.SortFields.Add Key:=Range( _
        "E12:E" & derlin), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "OR,ARG,Participation", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Résultat").Sort
        .SetRange Range("A11:E" & derlin)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.ScreenUpdating = True
End Sub
 

oliv

XLDnaute Nouveau
Re : Probleme Tri automatique avec VBA

Merci beaucoup pour la peine que vous vous donnez, mais chez moi ca marche toujours pas..Cette fois ci par contre il n y a plus que la 1ere ligne qui ne veut pas etre trier...
Chez vous est ce que tout marche? (avec le fichier complet?)

Merci encore...
 

oliv

XLDnaute Nouveau
Re : Probleme Tri automatique avec VBA

Ok...Jai trouvé... Il fallait changer le Header = xlYes en Header = xlNo, puisque j ai défini ma plage directement sans les titres, y a pas besoin de mettre une ligne de titre...et voila...

Merci a vous quand meme
Au plaisir
 

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T