快速生成雷达扇形玫瑰图的VBA程序

zyspecial

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

生成玫瑰图后，可用原数据类别制作一个数值相同、间隔均匀的饼图，饼图为透明无填充，借用饼图的数据标签作为玫瑰图的数据标签。

zyspecial

按照上述思路和方法组合美化后的玫瑰图如下图所示。

493861364

生成一个新的sheet，创建作图数据源，生成图表并格式化，思路很清晰，向老师好好学习

terry367

漂亮

lixiujianlee

我为什么选择生成之后就乱糟糟   密密麻麻的

zyspecial

lixiujianlee 发表于 2021-10-12 14:28
我为什么选择生成之后就乱糟糟   密密麻麻的

你是怎么操作的，截个图传上来看下

xiaojia8211

我怎么运行了宏只生成了构图数据，没有自动建立图表呢？

zyspecial

把“On Error Resume Next”语句注释掉，看出错的地方是什么

493861364

我试过了，没问题啊，楼上的朋友把附件发上来，研究学习一下

xiaojia8211

请帮忙看看，生成数据，不自动画图