按照选择数据生成最大值最小值的环形图。代码共享

天下任我行1986

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cht As Chart, ser As Series
Set cht = Sheet1.ChartObjects("图表 3").Chart
cht.ClearToMatchColorStyle
cht.ApplyDataLabels xlDataLabelsShowNone
If Not Intersect(Sheet1.UsedRange, Target) Is Nothing Then
cht.SetSourceData Intersect(Sheet1.UsedRange, Target)
For Each ser In cht.FullSeriesCollection
arr = ser.Values
ma = Application.Max(arr): mi = Application.Min(arr)
ma1 = Application.Match(ma, arr, 0): mi1 = Application.Match(mi, arr, 0)
ser.XValues = Intersect(Sheet1.UsedRange, Target).Range("a1").End(xlToLeft).Resize(Intersect(Sheet1.UsedRange, Target).Rows.Count, 1)
ser.Points(ma1).ApplyDataLabels , , , , , True, True, True, , "|"
ser.Points(mi1).ApplyDataLabels , , , , , True, True, True, , "|"
ser.Points(ma1).Format.Fill.ForeColor.RGB = RGB(255, 0, 255)
ser.Points(mi1).Format.Fill.ForeColor.RGB = RGB(255, 0, 255)
Next
End If
End Sub
颜色需要可以自行更改，图形模式需要可以自行更改。

天下任我行1986

附件上传，供参考

qjz951

谢谢分享，学习了。

fjndss

高手~~谢谢中

ljtao888

低版本应该用不了吧

jeanria

努力学习，感谢分享