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 60 61 62 63 64 65 66 67 68 69 70
| Sub traitement()
'Déclaration des variables
Dim oRng As Range
Dim t As Integer
Dim ListeLig As String
Dim LigChoisie As String
Dim i asInteger
'Avec "Date 1
With Worksheets("Date 1)
'On redéfinie oRng sur O6 de "Date 1
Set oRng = .Range("O6")
'On boucle de i = dernière ligne non vide de la colonne 15 à 1 (décroissant)
For i = .Cells(.Cells.Rows.Count, 15).End(xlUp).Row - 1 To 1 Step -1
'Si on a une valeur numérique en oRng avec un décalage de i lignes...
If IsNumeric(oRng.Offset(i, 0)) Then
'... alors sur la colonne à droite on place sa valeur absolue
oRng.Offset(i, 34) = Abs(oRng.Offset(i, 0))
End If
Next i
End With
Sheets("Date 1).Select
Sheets("Date 1).AutoFilterMode = False
Range("AW5").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Date 1).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Date 1).AutoFilter.Sort.SortFields.Add Key:= _
Range("AW:AW"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Date 1).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("6").Select
Selection.Copy
Sheets("CPN1").Select
Range("A5").Select
ActiveSheet.Paste
Randomize
With ThisWorkbook.Worksheets("Date 1)
ListeLig = "" ' initialisation de la liste des lignes choisies pour cette feuille
For i = 1 To 2 ' on va piocher deux lignes
' définition de la ligne piochées
LigChoisie = Int((.Cells(.Rows.Count, 1).End(xlUp).Row - 7) * Rnd + 7)
' tant que la ligne piochée a déjà été utilisée
While ListeLig Like "*$" & LigChoisie & "$*"
' on en pioche une autre
LigChoisie = Int((.Cells(.Rows.Count, 1).End(xlUp).Row - 7) * Rnd + 7)
Wend
' on ajoute la ligne piochée à la liste des lignes utilisées
ListeLig = ListeLig & "$" & LigChoisie & "$"
' on écrit la ligne
.Cells(LigChoisie, 1).Resize(1, .UsedRange.Columns.Count).Copy ThisWorkbook.Worksheets("CPN1").Cells(6, 1).Offset(t, 0)
t = t + 1
Next i
End With
End Sub |
Partager