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

493861364

xiaojia8211 发表于 2021-10-13 11:35
请帮忙看看，生成数据，不自动画图

先选择数据区域，然后运行代码你运行完是个啥样子啊

xiaojia8211

我运行完就有数据，没有图，怪了

493861364

xiaojia8211 发表于 2021-10-13 16:50
我运行完就有数据，没有图，怪了

你把第一句注释掉，看有啥报错吗？可能是从生成图表的语句有问题的

wangg913

xiaojia8211 发表于 2021-10-13 11:35
请帮忙看看，生成数据，不自动画图

代码正常运行。
选中数据区，然后运行。
代码没经修饰，但可以运行。

wangg913

我之前做过一个模板。不过是用饼图做的。
https://club.excelhome.net/thread-1596268-1-1.html
回头改改再发一版，一维的。

wangg913

数据表保留一个图表。

1. Option Base 1
   
2. Sub Rose()
   
3.     Dim sht As Worksheet
   
4.     Dim cht As Chart
   
5.     Dim arr, crr(), I%, J%, N%, A%
   
6.     Set sht = Worksheets("Sheet1")
   
7.     Set cht = sht.ChartObjects(1).Chart
   
8.     Do While cht.SeriesCollection.Count
   
9.         cht.SeriesCollection(1).Delete
   
10.     Loop
    
11.     arr = sht.Range("A1").CurrentRegion.Columns(2)
    
12.     A = UBound(arr) - 1
    
13.     N = Int(360 / A)
    
14.     For I = 1 To A
    
15.         ReDim crr(N * A)
    
16.         For J = 1 To N
    
17.             crr(I * N - N + J) = arr(I + 1, 1)
    
18.         Next
    
19.         With cht.SeriesCollection.NewSeries
    
20.             .ChartType = xlRadarFilled
    
21.             .Values = crr
    
22.         End With
    
23.     Next
    
24.     cht.SetElement msoElementPrimaryValueAxisShow
    
25.     cht.SetElement msoElementDataLabelNone
    
26. End Sub

复制代码

wangg913

上个附件。。

493861364

wangg913 发表于 2021-10-14 10:06
上个附件。。

直接构造数组，这个办法好

版主多发点这种简单、实用，能看得懂的代码吧，版主之前的帖子里代码看不懂啊

xiaojia8211

果然是生成图表，这一句有问题，我在琢磨琢磨

xiaojia8211

改写了一段代码，问题解决了，但我不知道为什么原代码在我2010版本会出错