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
|
Public Const nomFeuille1 As String = "Sheet1"
Public Const nomFeuille2 As String = "Sheet2"
Public Const nomFeuille3 As String = "Sheet3"
Public Const colVille As Integer = 4
Public Const colClasse As Integer = 5
Sub triDonnees(col As String)
Sheets(nomFeuille1).Select
Selection.Sort Key1:=Range(col), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End Sub
Sub traitement()
Call traiterBest(nomFeuille2, colVille)
Call traiterBest(nomFeuille3, colClasse)
End Sub
Sub traiterBest(nomFeuille As String, colDonnees As Integer)
Dim i, j, cpt As Integer
Dim str As String
Call triDonnees(Chr(colDonnees + 64) & "2")
i = 2
j = 0
str = ""
cpt = 0
While Trim(Sheets(nomFeuille1).Cells(i, colDonnees).Value) <> ""
If Sheets(nomFeuille1).Cells(i, colDonnees).Value <> str Then
cpt = 1
str = Sheets("Sheet1").Cells(i, colDonnees).Value
Else
cpt = cpt + 1
End If
If cpt <= 2 Then
j = j + 1
Sheets(nomFeuille).Cells(j, 1).Value = Sheets(nomFeuille1).Cells(i, 2).Value
Sheets(nomFeuille).Cells(j, 2).Value = Sheets(nomFeuille1).Cells(i, colDonnees).Value
End If
i = i + 1
Wend
End Sub |
Partager