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
|
Sub OnSite()
Dim Source As Worksheet, Cible As Worksheet, RgSource As Range, RgCible As Range
Dim Données(), Résultats(), NewRés()
Dim i As Long, j As Long, NbL As Long, NbC As Long
Const NbColRés = 15
Set Source = ActiveWorkbook.Worksheets("CHARGEMENT")
Set Cible = ActiveWorkbook.Worksheets("ON SITE")
Set RgSource = Source.Range("D12:BP1519") 'Plage contenant toutes les données
Set RgCible = Cible.Range("A4") '1ère cellule de la plage cible
Application.ScreenUpdating = False
'On nettoie la cible (valeurs et formats)
RgCible.Resize(Cible.Rows.Count - RgCible.Row + 1, NbColRés).Clear
'on stocke dans un tableau de variables toutes les valeurs de la plage de données
Données = RgSource.Value2
'i : Index pour de décalage en ligne de la plage cible
i = 0
For j = 1 To UBound(Données, 1) 'J varie de 1 aux nombre de lignes de la plage des données (ici 1508 lignes)
If IsNumeric(Données(j, 10)) And Not IsEmpty(Données(j, 10)) Then
If Données(j, 10) > 0 Then
'Ici Données(j,10) est une valeur numérique supérieure à 0
Select Case Données(j, 10)
Case "(j,.Offset(5).Value)"
i = i + 1
'On redimensionne le tableau Résultats et on le remplit (au début i vaut 1)
'
'Remarque : le tableau est en colonnes-lignes et non pas en lignes-colonnes
'
ReDim Preserve Résultats(1 To NbColRés, 1 To i)
Résultats(1, i) = Données(j, 1)
Résultats(2, i) = Données(j, 2)
Résultats(3, i) = Données(j, 5)
Résultats(4, i) = Données(j, 4)
Résultats(5, i) = Application.WorksheetFunction.Sum(Range(Données(j, 10).value & ":" & (Donnéesj.Offset(5).value)))
Case Else
'Rien
End Select
End If
End If
Next
If i = 0 Then
MsgBox "Aucune ligne ne correspond aux critères"
Exit Sub
End If
'On transpose les résultats pour passer dans un tableau en lignes, colonnes
NbL = UBound(Résultats, 2) 'Nbre de lignes = dimension 2 du tableau Résultats
NbC = UBound(Résultats, 1) 'Nbre de colonnes = dimension 1 du tableau Résultats
'Nouveau tableau de Résultats
ReDim NewRés(1 To NbL, 1 To NbC)
'Transposition
For i = 1 To NbL
For j = 1 To NbC
NewRés(i, j) = Résultats(j, i)
Next j
Next i
'On attribue à la plage cible redimensionnée les résultats
RgCible.Resize(NbL, NbC).Value2 = NewRés
'On se positionne juste au dessus de la cellule cible (True : avec défilement d'écran)
Application.Goto RgCible.Offset(-1, 0), True
Application.ScreenUpdating = True
End Sub |
Partager