Excel VBA一键创建雷达图

Option ExplicitSub CreateRadarChart()    ' 创建能力评估雷达图    ' 作者: Excel每日一学    ' 日期: 2026年1月    Dim ws As Worksheet    Dim chartObj As ChartObject    Dim dataRange As Range    Dim chart As chart    Dim lastRow As Long, lastCol As Long    Dim i As Integer    ' 设置错误处理    On Error GoTo ErrorHandler    ' 获取活动工作表    Set ws = ActiveSheet    ' 查找数据范围    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column    ' 检查是否有足够的数据    If lastRow < 2 Or lastCol < 2 Then        MsgBox "数据不足，请确保第一行是标题，第一列是能力维度，第二列是评分。", vbExclamation        Exit Sub    End If    ' 选择数据范围 (假设第一列是维度，第二列是评分)    Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 2))    ' 创建雷达图    Set chartObj = ws.ChartObjects.Add(Left:=100, Width:=400, Top:=50, Height:=300)    Set chart = chartObj.chart    With chart        ' 设置图表类型为雷达图        .ChartType = xlRadarMarked        ' 设置数据源        .SetSourceData Source:=dataRange        ' 设置图表标题        .HasTitle = True        .ChartTitle.Text = "能力评估雷达图"        .ChartTitle.Font.Size = 14        .ChartTitle.Font.Bold = True        ' 设置图例        .HasLegend = True        .Legend.Position = xlLegendPositionBottom        ' 设置雷达图样式        .PlotArea.Format.Fill.ForeColor.RGB = RGB(240, 248, 255)        .Axes(xlCategory).HasMajorGridlines = True        .Axes(xlCategory).MajorGridlines.Format.Line.ForeColor.RGB = RGB(200, 200, 200)        ' 设置数据系列格式        If .SeriesCollection.Count > 0 Then            With .SeriesCollection(1)                .MarkerStyle = xlMarkerStyleCircle                .MarkerSize = 7                .Format.Fill.ForeColor.RGB = RGB(30, 87, 153)                .Format.Line.ForeColor.RGB = RGB(30, 87, 153)                .Format.Line.Weight = 2            End With        End If        ' 设置雷达轴格式        With .Axes(xlValue)            .MinimumScale = 0            .MaximumScale = 10            .MajorUnit = 2            .HasTitle = True            .AxisTitle.Text = "评分 (1-10)"        End With    End With    ' 调整图表位置和大小    chartObj.Left = ws.Columns("E").Left    chartObj.Top = ws.Rows(2).Top    chartObj.Width = 450    chartObj.Height = 350    ' 添加说明文本框    Dim textBox As Shape    Set textBox = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, _                                        chartObj.Left, _                                        chartObj.Top + chartObj.Height + 10, _                                        450, 60)    With textBox        .TextFrame.Characters.Text = "说明: 此雷达图展示了各项能力的评分情况。" & vbCrLf & _                                     "最高分为10分，内圈为0分，外圈为10分。"        .TextFrame.HorizontalAlignment = xlHAlignLeft        .TextFrame.VerticalAlignment = xlVAlignTop        .Fill.ForeColor.RGB = RGB(255, 255, 255)        .Line.ForeColor.RGB = RGB(200, 200, 200)        .TextFrame.Characters.Font.Size = 10        .TextFrame.Characters.Font.Color = RGB(100, 100, 100)    End With    ' 美化工作表    ws.Columns("A:B").AutoFit    ws.Range("A1:B1").Font.Bold = True    ws.Range("A1:B1").Interior.Color = RGB(240, 240, 240)    MsgBox "雷达图创建成功!", vbInformation    Exit SubErrorHandler:    MsgBox "创建雷达图时出错: " & Err.Description, vbCriticalEnd SubSub QuickRadarForAssessment()    ' 快速创建评估雷达图 - 简化版本    Dim ws As Worksheet    Set ws = ActiveSheet    ' 添加示例数据 (如果当前工作表为空)    If ws.Cells(1, 1).Value = "" Then        ws.Cells(1, 1).Value = "能力维度"        ws.Cells(1, 2).Value = "评分"        Dim abilities As Variant        abilities = Array("技术能力", "沟通能力", "解决问题", "团队协作", _                          "创新能力", "项目管理", "学习能力", "领导力")        Dim scores As Variant        scores = Array(9, 7, 8, 9, 6, 7, 8, 5)        Dim i As Integer        For i = 0 To UBound(abilities)            ws.Cells(i + 2, 1).Value = abilities(i)            ws.Cells(i + 2, 2).Value = scores(i)        Next i    End If    ' 调用主程序创建雷达图    CreateRadarChartEnd Sub

#VBA常用代码