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
|
Sub ChangeColorAndSeparateData()
Dim ws As Worksheet
Dim lastRow As Long
Dim valueRange As Range
Dim previousValue As Variant
Dim cell As Range
Dim chartObj As ChartObject
Dim chartDataRange As Range
Dim seriesIndex As Integer
Dim startRow As Long
Dim endRow As Long
' Spécifiez la feuille de calcul sur laquelle vous travaillez
Set ws = ThisWorkbook.Sheets("Iron_evol")
' Spécifiez la plage de données pour les valeurs
With ws
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set valueRange = .Range("B2:B" & lastRow)
End With
' Parcourez les valeurs pour changer la couleur des cellules et séparer les séries de données
previousValue = valueRange(1).Value
seriesIndex = 1
startRow = 2 ' Ligne de départ de la série de données en cours
For Each cell In valueRange
If cell.Value < (previousValue - 10) Then
' Changez la couleur de la cellule en rouge
cell.Interior.Color = RGB(255, 0, 0)
' Définissez la ligne de fin de la série de données en cours
endRow = cell.Row - 1
' Vérifiez s'il y a suffisamment de données pour créer un graphique en points
If endRow >= startRow Then
' Créez un graphique en points avec la série de données
Set chartObj = ws.ChartObjects.Add(Left:=10, Width:=400, Top:=10, Height:=300)
Set chartDataRange = ws.Range(ws.Cells(startRow, 1), ws.Cells(endRow, 2))
With chartObj.Chart
.ChartType = xlXYScatter
.SetSourceData Source:=chartDataRange
.HasTitle = True
.ChartTitle.Text = "Graphique série " & seriesIndex
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Valeurs x"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Valeurs y"
End With
seriesIndex = seriesIndex + 1
End If
' Définissez la ligne de départ de la prochaine série de données
startRow1 = cell.Row
End If
previousValue = cell.Value
Next cell
' Vérifiez s'il y a une dernière série de données après la dernière cellule colorée
If hasSeries Then
' Définissez la ligne de fin de la dernière série de données
endRow1 = lastRow
' Vérifiez s'il y a suffisamment de données pour créer un graphique en points
If endRow1 >= startRow1 Then
' Créez un graphique en points avec la série de données
Set chartObj = ws.ChartObjects.Add(Left:=10, Width:=400, Top:=10, Height:=300)
Set chartDataRange = ws.Range(ws.Cells(startRow1, 1), ws.Cells(endRow1, 2))
With chartObj.Chart
.ChartType = xlXYScatter
.SetSourceData Source:=chartDataRange
.HasTitle = True
.ChartTitle.Text = "Graphique série " & seriesIndex
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Valeurs x"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Valeurs y"
End With
End If
End If
End Sub |
Partager