Salut Maroon,
voilà, voilà...
La macro s'attend à des comportements intelligents de la part des utilisateurs !!
- même nombre de villes dans chaque feuille que stipulé dans 'INDICATEUR' ;
- ces villes sont classées dans le même ordre que dans 'INDICATEUR' ;
- si création d'une nouvelle feuille, prière de faire attention à la similitude d'eaurtaugrâfe pour être reconnue.
! Si tu penses que cela peut-être utile !
Fonctions supplémentaires possibles si tu modifies une ou plusieurs valeurs-seuil :
- un double-clic sur 1 colonne recalculerait cette colonne uniquement ;
- une multi-sélection horizontale unique recalculerait les seules colonnes ciblées ;
- une multi-sélection de plusieurs colonnes non-contigües (avec CTRL) recalculerait les seules colonnes ciblées.
À toi de voir...
Private Sub cmdGO_Click()
'
Dim tTab, tPluv, iStep%, lgRow&, lgIdx&, dblTot#, dblTemp#
'
Me.cmdGO.BackColor = &HC0&
Dummy = DoEvents()
Application.ScreenUpdating = False 'évitons les scintillements d'écran
'
iCol = Range("A" & Rows.Count).End(xlUp).Row - 4 'nombre de villes calculé sur le nombre de lignes en 'INDICATEUR' [A:A]
Range("B5").Resize(iCol, Cells(1, Columns.Count).End(xlToLeft).Column - 1).Clear 'nettoyage 'INDICATEUR'
'
For iSheet = 2 To Cells(1, Columns.Count).End(xlToLeft).Column 'on parcourt les feuilles telles qu'indiquées en ligne 1
For k = 1 To Sheets.Count 'boucle de vérification de l'existence de la feuille ciblée par iSheet
If Sheets(k).Name = CStr(Cells(1, iSheet)) Then 'le calcul se fait si la feuille existe
iStep = CInt(Cells(4, iSheet)) 'valeur du Step pour cette feuille
dblTot = CDbl(Cells(3, iSheet)) 'valeur du Seuil pour cette feuille
tPluv = Cells(5, iSheet).Resize(iCol, 1).Value 'préparation du tableau de résultats pour cette feuille
With Worksheets(CStr(Cells(1, iSheet))) 'prises d'info dans la feuille à traiter
lgRow = .Range("A" & Rows.Count).End(xlUp).Row 'nombre de lignes de datas
tTab = .Range("B2").Resize(lgRow - 1, iCol).Value 'mise en tableau des datas
End With
For x = 1 To UBound(tTab, 2)
lgIdx = 0 'valeur-repère pour calcul CELLULES
For y = 1 To UBound(tTab, 1) - (iStep - 1)
dblTemp = 0
For Z = 0 To iStep - 1
dblTemp = dblTemp + CDbl(tTab(y + Z, x))
Next
If dblTemp >= dblTot Then
'tPluv(x, 1) = CInt(tPluv(x, 1)) + 1 'instruction BLOCS non-utilisée... pfff...
tPluv(x, 1) = CInt(tPluv(x, 1)) + IIf(lgIdx < y, iStep, (y + iStep - 1) - lgIdx) 'calcul CELLULES
lgIdx = y + iStep - 1
End If
Next
Next
Cells(5, iSheet).Resize(iCol, 1).Value = tPluv 'affichage des résultats de la feuille traitée
Exit For
End If
Next
Next
Range("B5").Resize(iCol, iSheet - 2).Borders.LineStyle = xlContinuous 'bordures
'
Application.ScreenUpdating = True
Me.cmdGO.BackColor = &HC000&
'
End Sub
Suite au prochain épisode!
A+