|
Sub 雷达扇形玫瑰图() '选中数据区域(左列类别右列数值),运行此过程即可快速生成
On Error Resume Next
Application.ScreenUpdating = False
Dim i%, j%, k%, x1%, x2%, R%, N%, X, Rng As Range
If Selection.Count = 1 Then ActiveCell.CurrentRegion.Select
Selection.Copy
Worksheets.Add after:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
R = Selection.Rows.Count
N = R - 1
Arr = Range(Cells(2, 2), Cells(R, 2))
X = 360 / N
For i = 1 To N
x1 = Round((i - 1) * X) + 1
x2 = Round(i * X)
For j = x1 To x2
Cells(j, 4 + k) = Arr(i, 1)
Next
k = k + 1
Next
Set Rng = Cells(1, 4).CurrentRegion
ActiveSheet.Shapes.AddChart2(317, xlRadarFilled, 200, 30, 500, 500).Select
With ActiveChart
.SetSourceData Source:=Rng
.Legend.Delete
.ChartGroups(1).RadarAxisLabels.Delete
.Axes(xlValue).Delete
.Axes(xlValue).MajorGridlines.Delete
End With
Application.ScreenUpdating = True
End Sub
生成玫瑰图后,可用原数据类别制作一个数值相同、间隔均匀的饼图,饼图为透明无填充,借用饼图的数据标签作为玫瑰图的数据标签。
|
评分
-
1
查看全部评分
-
|