在 Excel VBA 散点图中打破连续线

Question

我在 VBA 中创建了一个散点图，并为该系列设置了线条，该线条工作完美，除了线条从点到点连续，而不是在每个点的末尾停止。换句话说，理想的解决方案将为每个系列值“点”生成一条垂直线。

这是我创建图表的过程的 vba 代码：

Sub CreateScatterPlotWithUniqueBrandColors()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim chart As ChartObject
    Dim chartSheet As Worksheet
    Dim scatterSeries As series
    Dim i As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet3") ' Replace "Sheet3" with your actual sheet name
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    On Error Resume Next
    Set chartSheet = ThisWorkbook.Sheets("PriceBenchmark")
    On Error GoTo 0
    
    If chartSheet Is Nothing Then
        Set chartSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        chartSheet.Name = "PriceBenchmark"
    End If
    
    ' Create a new column for the BrandSize values (if not already created)
    If ws.Cells(1, 5).value <> "BrandSize" Then
        ws.Cells(1, 5).value = "BrandSize"
        For i = 2 To lastRow
            ws.Cells(i, 5).value = ws.Cells(i, 1).value & "-" & ws.Cells(i, 3).value
        Next i
    End If
    
    ' Create a new column for the Size Numerical values (if not already created)
    If ws.Cells(1, 6).value <> "Size Numerical" Then
        SortDataAndAssignSizeNumerical
    End If
    
    ' Calculate minimum value for the axis scale
    Dim minValue As Double
    minValue = Application.WorksheetFunction.Min(ws.Range("F2:F" & lastRow))
    
    ' Create scatter plot
    Set chart = chartSheet.ChartObjects.Add(0, 0, chartSheet.Cells(1, 1).width, chartSheet.Cells(1, 1).height)
    'Set chart = ws.ChartObjects.Add(100, 100, 600, 300)
    chart.chart.ChartType = xlXYScatter
    chart.chart.HasTitle = True
    chart.chart.ChartTitle.Text = "Price / Value Benchmark"
    
    ' Set axis labels
    chart.chart.Axes(xlCategory).HasTitle = True
    chart.chart.Axes(xlCategory).AxisTitle.Text = "Size:Brand"
    chart.chart.Axes(xlValue).HasTitle = True
    chart.chart.Axes(xlValue).AxisTitle.Text = "Price"
    
    ' Remove gridlines
    chart.chart.Axes(xlCategory).MajorGridlines.Delete
    chart.chart.Axes(xlValue).MajorGridlines.Delete
    
    ' Set minimum scale for category (Size Numerical) axis
    'chart.chart.Axes(xlCategory).MinimumScale = minValue
    chart.chart.Axes(xlCategory).MinimumScale = 0
    
    ' Set Major Unit for Value (Price) Axis
    chart.chart.Axes(xlValue).MajorUnit = 5 ' Adjust this value as needed
    chart.chart.Axes(xlCategory).MajorUnit = 2
    
    ' Set chart size
    'chart.width = 600
    'chart.height = 300
    chart.Left = 0
    chart.Top = 0
    chart.width = 14.17 * 72
    chart.height = 8.78 * 72
    'chart.width = Application.width
    'chart.height = Application.height


    Dim brandColors As Object
    Set brandColors = CreateObject("Scripting.Dictionary")
    
    Dim uniqueBrands As Object
    Set uniqueBrands = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        Dim brand As String
        brand = ws.Cells(i, 1).value
        
        If Not brandColors.Exists(brand) Then
            brandColors(brand) = GetRandomRGBColor()
        End If
        
        If Not uniqueBrands.Exists(brand) Then
            uniqueBrands.Add brand, brand
        End If
    Next i
    
    ' Add scatter series data
    Set scatterSeries = chart.chart.SeriesCollection.NewSeries
    scatterSeries.Name = "Scatter Data"
    scatterSeries.Values = ws.Range("D2:D" & lastRow) ' Price column
    scatterSeries.xValues = ws.Range("F2:F" & lastRow) ' Size Numerical column
    
    ' Add data labels for each point
    scatterSeries.HasDataLabels = True
    scatterSeries.HasLeaderLines = True
    scatterSeries.DataLabels.Position = xlLabelPositionRight
    scatterSeries.LeaderLines.Border.Color = RGB(192, 192, 192)
    scatterSeries.LeaderLines.Format.Line.DashStyle = msoLineSysDash
    scatterSeries.LeaderLines.Format.Line.Weight = 0.8
    'scatterSeries.LeaderLines.Border.colorIndex = 5
    Dim pointsCount As Long
    pointsCount = scatterSeries.Points.Count
    'scatterSeries.Points(i).HasLeaderLines = True
    For i = 1 To pointsCount
    
        Set Point = scatterSeries.Points(i)
        
        ' Adjust the data label position by 1 pixel to the right
        labelLeft = Point.DataLabel.Top + 8
        Point.DataLabel.Top = labelLeft
        
        ' Add a leader line
        scatterSeries.ApplyDataLabels
        Point.ApplyDataLabels
        
        'scatterSeries.Points(i).HasLeaderLines = True
        scatterSeries.Points(i).MarkerStyle = xlMarkerStyleCircle
        scatterSeries.Points(i).DataLabel.Text = ws.Cells(i + 1, 2).value ' 'Deal' column
        scatterSeries.Points(i).DataLabel.Font.size = 5
        scatterSeries.Points(i).MarkerSize = 5 ' Adjust this value as needed
        scatterSeries.Points(i).Format.Line.Visible = msoTrue
        scatterSeries.Points(i).Format.Line.ForeColor.RGB = RGB(192, 192, 192)
        scatterSeries.Points(i).Format.Line.DashStyle = msoLineSysDash
        scatterSeries.Points(i).Format.Line.Weight = 0.8
        ' Set point color based on the brand
        scatterSeries.Points(i).Format.Fill.ForeColor.RGB = brandColors(ws.Cells(i + 1, 1).value)
    Next i
    
    ' Hide major tick marks on the x-axis
    chart.chart.Axes(xlCategory).TickLabelPosition = xlTickLabelPositionNone
    chart.chart.Axes(xlValue).TickLabels.Font.size = 4 ' Adjust the font size as needed
    chart.chart.HasLegend = False

    ' Activate the PriceBenchmark sheet
    chartSheet.Activate
    
    ' Set the Zoom on the Chart Sheet
    ActiveWindow.Zoom = 120


End Sub

在下面设置线的代码中，我需要一种方法来中断线或类似的东西，以便它不会继续到 x 轴上的下一个点，如图所示：

scatterSeries.Points(i).Format.Line.Visible = msoTrue
        scatterSeries.Points(i).Format.Line.ForeColor.RGB = RGB(192, 192, 192)
        scatterSeries.Points(i).Format.Line.DashStyle = msoLineSysDash
        scatterSeries.Points(i).Format.Line.Weight = 0.8

这是示例数据：

Answer 1

如果没有任何示例数据，很难创建图表。我提供的代码演示了如何从现有图表中删除非垂直网格线。

' Create scatter line chart
Sub CreateChart()
    ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines).Select
    ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$B$9")
    Selection.Top = [d2].Top
    Selection.Left = [d2].Left
End Sub

' Remove non-vertical lines
Sub RemvoeLine()
    Dim cht As chart
    Dim LstRow As Integer
    Set cht = Sheet1.Shapes(1).chart
    LstRow = [a1].End(xlDown).Row
    For i = 3 To LstRow
        If Cells(i, 1) <> Cells(i - 1, 1) Then
            cht.FullSeriesCollection(1).Points(i - 1).Format.Line.Visible = msoFalse
        End If
    Next
End Sub

示例数据和图表