tri ordre alphabetique

[alexistak]

Est ce vous auriez une macro en stock qui tri une liste par par ordre alphabetique en fonction des nom situe en colonne C par exemple?

Merci

[David]

Salut

voila :

Sub Rangement() ' Triage de la feuille "Feuil1" par ordre croissant sur la première colonne
   Sheets("Feuil1").Range("A1:I1000").Select   ' Sélection de toute la zone de données pour le tri
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom  ' Instructions de tri
    Range("A1").Select                                                ' Selection A1
Sheets(Feuille).Select                                                ' Selection feuille de travail
End Sub

Tu remplaces Feuil1 par lez nom de ta feuille et A1:I1000 par ta zone a trier.

[alexistak]

Je vais tester merci

[alexistak]

Comment tu l'ecris dans le code j'ai des msg d'erreurs
comment tu l'appelle dans le main cette fonction
call rangement(?,?,?)

merci

[alexistak]

Sub Main1()

'***Variables***
Dim GCCReport As Workbook                               'Workbook of report from GCC
Dim row_count As Integer                                'Counter for no of rows in GCC Report

'opens dialog box to choose report
Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
    If Filename = False Then
        ' They pressed Cancel
        MsgBox "Stopping because you did not select a file"
        Exit Sub
    Else
        Workbooks.Open (Filename)
    End If

    
    row_count = RowCount

    With ActiveWorkbook.Worksheets("Sheet1")
        'adjust column width
        .Columns("A").ColumnWidth = 10
        .Columns("B").ColumnWidth = 10
        .Columns("C").ColumnWidth = 10
        .Columns("D").ColumnWidth = 10
        .Columns("E").ColumnWidth = 10
        .Columns("F").ColumnWidth = 5
        .Columns("G").ColumnWidth = 5
        .Columns("H").ColumnWidth = 5
        .Columns("I").ColumnWidth = 8
        .Columns("L").ColumnWidth = 25
        .Columns("M").ColumnWidth = 8
        .Columns("N").ColumnWidth = 25
        .Columns("O").ColumnWidth = 20
        .Columns("P").ColumnWidth = 7


        'adjust row heigth
        .Rows("4:20000").AutoFit

        'Set Borders for Cells
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Weight = xlHairline
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.Color = RGB(0, 0, 0)
        .Range(Worksheets("Sheet1").Cells(4, 1), Worksheets("Sheet1").Cells(row_count, 17)).Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.Weight = xlHairline
        .Range("A3:Q3").Borders.Color = RGB(0, 0, 0)

       End With


Call ColorUPC(5, row_count, 14)
Call SeperateUPC(5, row_count, 14)
Call PrintSetup(65, 2)

End Sub




'~~~~~~~~~~~~~~~~~Function to count rows in GCCReports~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function RowCount() As Integer

Dim m As Integer            'Loop Counter
m = 5

Do While (ActiveWorkbook.Worksheets("Sheet1").Cells(m, 2).Value <> 0)

m = m + 1
Loop

RowCount = m - 1

End Function

'~~~~~~~~~~~~~~~~~~~Sub to color UPCs in order to separate them~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Arguments~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'start_row              specifies where to start the separation of UPCs
'row_max                row in which to end sub
'col_max                column until which background color should be changed
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'uses UPC as reference to sort


Sub ColorUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 2)

Dim i As Integer
i = start_row
marker = 0
'MsgBox row_max

Do While (i <= row_max)

If Worksheets("Sheet1").Cells(i, comp_row + 1) <> Worksheets("Sheet1").Cells(i - 1, comp_row + 1) Then
    
    With Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(i, 1), Worksheets("Sheet1").Cells(i, col_max)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .Color = RGB(0, 0, 0)
    End With
    
    marker = marker + 1
    'MsgBox "Marker  " & marker & " Loop counter  " & i
End If

If (marker Mod 2 = 0) Then
    Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(i, 1), Worksheets("Sheet1").Cells(i, col_max)).Interior.Color = RGB(255, 228, 181)
End If


i = i + 1
Loop

End Sub

Sub PrintSetup(resize As Double, sheet As Integer)

Dim Run As Boolean

Run = Application.Dialogs(xlDialogPrinterSetup).Show
    
If Run = False Then
MsgBox "Stopping Print Setup since no printer was chosen"
Exit Sub
Else
    '************Page Setup***************
    With Workbooks("GCC Violation Report Filter Macro.xls").Worksheets(sheet).PageSetup
        '.PaperSize = xlPaperA3
        .Zoom = resize
        .Orientation = xlLandscape
        .TopMargin = 0.5
        .BottomMargin = 0.5
        .RightMargin = 0.5
        .LeftMargin = 0.5
        '.PrintArea = "A1:AR10"
    End With
   
Application.Dialogs(xlDialogPrintPreview).Show
End If
'    '************Print Dialog***********
'    ActiveWorkbook.Worksheets(1).PrintOut
        
End Sub

'uses UPC as reference to sort

Sub SeperateUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 2, Optional del As Boolean = True)

Dim i As Integer
i = start_row
before = Worksheets("Sheet1").Cells(i - 1, comp_row)

Do While (i <= row_max)
    
    If Worksheets("Sheet1").Cells(i, comp_row) = before Then
    
    before = Worksheets("Sheet1").Cells(i, comp_row)
    
    If del = True Then
    Worksheets("Sheet1").Cells(i, comp_row).ClearContents
    End If
    
    Worksheets("Sheet1").Cells(i, comp_row).ClearContents
    
    
    
    Else
    
    before = Worksheets("Sheet1").Cells(i, comp_row)
    
    End If
    
    i = i + 1
    
Loop

End Sub

Ci joint le code (si ca peut t'aider)
Il range les separe les lignes par rapport a un nom correspondant a une colonne sub color.
Ensuite il efface les redondance pour avoir un groupe de lignes ayantle meme nom les unes apres les autre:
Et separe les groupe en coloriant une fois sur deux et en mettant un ligne.

[alexistak]

Quelqu'un peut m'aider, je sais que c est tout con. Mais je sais pas comment l'ecrire dans mon code cette fonction de tri