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 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
|
Sub Macro_ICP2()
'
' Macro_ICP2 Macro
'
'
Range("A1:AX150").Select
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 129
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 117
ActiveWindow.ScrollRow = 113
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Selection.Cut Destination:=Range("B1:AY150")
Range("B1:AY150").Select
Columns("A:A").ColumnWidth = 15.71
Range("A1").Select
ActiveCell.FormulaR1C1 = "Sélection"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A70"), Type:=xlFillDefault
Range("A2:A150").Select
Dim rngCel As Range
Dim ChkBx As CheckBox
For Each rngCel In Selection
With rngCel.MergeArea.Cells
If .Resize(1, 1).Address = rngCel.Address Then
Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
With ChkBx
.Text = "Moyenne?"
End With
End If
End With
Next rngCel
If ChkBx = True Then
Dim Ech As String, x As Long, y As Long, i As Long, z As Integer, Racine As String
Ech = Sh.Range("B" & Target.Row)
With Sh
x = WorksheetFunction.CountA(.Range("1:1"))
y = WorksheetFunction.CountA(.Range("A:A"))
z = 0
Racine = Left(Ech, InStrRev(Ech, " ") - 1)
For i = 2 To y
If Left(.Cells(i, 2).Value, Len(Racine)) = Racine Then
z = z + 1
End If
Next i
If z > 1 Then
.Cells(y + 5, 2) = Racine
For i = 3 To x
If WorksheetFunction.SumIfs(.Range(.Cells(2, i), .Cells(y, i)), .Range(.Cells(2, 2), .Cells(y, 2)), Racine & "*") = 0 Then
.Cells(y + 5, i) = "-"
Else
.Cells(y + 5, i) = WorksheetFunction.AverageIfs(.Range(.Cells(2, i), .Cells(y, i)), .Range(.Cells(2, 2), .Cells(y, 2)), Racine & "*")
End If
Next i
End If
End With
Cancel = True
End If
End Sub |