作者：绿色风
分类：
时间：2022-08-17
浏览：405
楼主
hustclm |
Q：如何用VBA批量生成雷达图？
A：用VBA代码批量生成。代码如下。
- Sub shengcheng()
- Dim i As Integer
- Dim j As Integer
- Dim k As Integer, h As Integer
- Dim sh1 As Worksheet, sh2 As Worksheet, mychart As ChartObject
- Dim arr, arr1(1 To 10000)
- Dim rng As Range, rng1 As Range
- Application.ScreenUpdating = False
- Set sh1 = Sheets("数据")
- Set sh2 = Sheets("图表")
- arr = sh1.Range("b2:b" & sh1.[b65536].End(xlUp).Row)
- h = UBound(arr) / 2
- r0 = 28
- h1 = 8.5
- w1 = 10
- Set rng1 = sh1.Range("e1:o1")
- For m = 2 To Cells(Rows.Count, 2).End(xlUp).Row
- If Cells(m, 2).Value <> "" Then n = n + 1: arr1(n) = Cells(m, 2).Value
- Next
- If sh2.ChartObjects.Count > 0 Then
- sh2.ChartObjects.Delete
- End If
- For i = 1 To h
- j = 2 * i
- k = 2 * i + 1
- sh1.Activate
- Set rng = sh1.Range(Cells(j, 4), Cells(k, 15))
- sh2.Activate
- ActiveSheet.Shapes.AddChart.Select
- ActiveChart.ChartType = xlRadar
- ActiveChart.SetSourceData Source:=rng
- ActiveChart.SeriesCollection(1).XValues = rng1
- Set mychart = ActiveSheet.ChartObjects(i)
- With mychart
- .Left = 10 + ((i - 1) Mod 3) * 300
- .Top = (Int(i / 3.5) * (h1 * r0 + 5)) + 30
- .Width = w1 * r0
- .Height = h1 * r0
- With mychart.Chart
- .HasTitle = True
- .ChartTitle.Text = arr1(i)
- End With
- End With
- Next
- Set rng = Nothing
- Set rng1 = Nothing
- Set arr = Nothing
- Application.ScreenUpdating = True
- sh2.Range("a1").Activate
- End Sub
效果图如下：
 批量生成雷达图.rar
|
2楼
芐雨 |
 |
3楼
亡者天下 |
 |
4楼
海洋之星 |
不错，谢谢分享，学习了 |
5楼
hustclm |
谢谢昆版的提醒，已添加效果图 |
6楼
kylecs |
果断学些了 |
7楼
寒月悲茄 |
|
8楼
老糊涂 |
下载学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一