动态突显Excel图表中的数据点

对于需要呈现大量数据的人，Excel是一个不可或缺的工具，简单易用且功能丰富。Excel中的图表可以将数据可视化，使得数据呈现更加直观，同时其简单的交互性质也极大地方便了数据的分析。

但是，在进行大数据的分析时，我们往往会面临到一个难题，那就是如何快速区分悬挂的数据点，特别是当数据点过多时，直接观察会非常的繁琐。在这种情况下，我们可以考虑通过动态突显的方式，方便更好地区别悬挂数据点，并获得更直观的数据分析结果。

思路

实现动态突显数据点需要进行两个主要的操作，并通过宏来互动实现：
1. 将图表中的所有点置为原点大小、原点颜色；
2. 通过代码的方式使这些悬挂的数据点逐一突显。

举一个小例子，首先生成Excel文件，并将其中一个月份的销售图表导入。在该图表中，有一些悬挂数据点需要突显，将其突显的方式包括改变点的大小和颜色。我们可以按照以下步骤实现该功能：

步骤一：基础数据导入

首先，我们将Excel文件中的销售数据进行提取，并生成销售数据表格。我们先来检查一下生成的数据，并查看是否存在悬挂点数据。

Sub Get_Data()
    Dim Sales As Variant
    Dim SalesSheet As Worksheet
    Dim LastRow As Long

    ' 获取数据表格
    Set SalesSheet = ActiveWorkbook.Sheets("Sales Sheet")
    LastRow = SalesSheet.Cells(SalesSheet.Rows.Count, "A").End(xlUp).Row
    Sales = SalesSheet.Range("A2:C" & LastRow).Value

    ' 排序根据月份
    Call Bubble_Sort(Sales)

    ' 创建数据表格
    Call Create_Sales_Table(Sales)
End Sub

Sub Bubble_Sort(temp As Variant)
    Dim i As Long, j As Long, num As Long
    Dim temps1 As Variant, temps2 As Variant, temps3 As Variant, swap

    num = UBound(temp) - LBound(temp)
    For i = 0 To num
        For j = i + 1 To num
            If temp(i, 1) > temp(j, 1) Then
                temps1 = temp(i, 1)
                temps2 = temp(i, 2)
                temps3 = temp(i, 3)
                temp(i, 1) = temp(j, 1)
                temp(i, 2) = temp(j, 2)
                temp(i, 3) = temp(j, 3)
                temp(j, 1) = temps1
                temp(j, 2) = temps2
                temp(j, 3) = temps3
            End If
        Next j
    Next i
End Sub

Sub Create_Sales_Table(temp As Variant)
    Dim SalesTable As ListObject
    Dim SalesSheet As Worksheet

    Set SalesSheet = ActiveWorkbook.Sheets("Sales Sheet")
    Set SalesTable = SalesSheet.ListObjects.Add(xlSrcRange, Range(" $A$ 1: $C$ " & UBound(temp, 1) + 1), , xlYes)

    ' 设置表格样式
    With SalesTable
        .Name = "Sales"
        .TableStyle = "TableStyleLight16"
    End With
End Sub

步骤二：导入图表

接下来，我们将月份销售图表导入到工作表中。需要提醒的是，该图表的设计必须为散点图，同时还要匹配我们需要的数据范围。

Sub Import_Chart()
    Dim SalesChart As ChartObject
    Dim SalesSheet As Worksheet
    Dim SalesTableAs ListObject

    Set SalesSheet = ActiveWorkbook.Sheets("Sales Sheet")
    Set SalesTable = SalesSheet.ListObjects("Sales")

    ' 创建图表并调整大小
    Set SalesChart = SalesSheet.ChartObjects.Add(Left:=420, Width:=350, Top:=20, Height:=300)
    With SalesChart
        .Chart.SetSourceData Source:=SalesTable.Range.Offset(columnsize:=SalesTable.ListColumns.Count - 3).Resize(columnsize:=2)
        .Chart.ChartType = xlXYScatter
        .Chart.HasTitle = True
        .Chart.ChartTitle.Text = "Monthly Sales"
    End With
End Sub

步骤三：基础突显宏

我们可以添加一个简单的突显宏来测试该功能。该宏可以将所有点置为原点大小、原点颜色，并使悬挂点以不同的颜色和大小呈现。下面是一个简单的示例宏：

Sub Highlight()
    Dim SalesChart As ChartObject
    Dim SalesSeries As Series
    Dim SalesPoint As Point
    Dim SalesSheet As Worksheet
    Dim i As Long
    Dim SalesData As Variant

    Set SalesSheet = ActiveWorkbook.Sheets("Sales Sheet")
    Set SalesChart = SalesSheet.ChartObjects("Chart 1")

    ' 获取销售数据
    Set SalesSeries = SalesChart.Chart.SeriesCollection(1)
    SalesData = SalesSeries.Values

    ' 将所有点颜色和大小设置为默认
    For i = 1 To UBound(SalesData)
        Set SalesPoint = SalesSeries.Points(i)
        With SalesPoint
            .MarkerSize = 2.25
            .MarkerForegroundColorIndex = xlAutomatic
            .MarkerBackgroundColorIndex = xlAutomatic
        End With
    Next i

    ' 突显悬挂点
    For i = 1 To UBound(SalesData)
        If SalesData(i) < 40 Then ' 假设这些点为悬挂点
            Set SalesPoint = SalesSeries.Points(i)
            With SalesPoint
                .MarkerSize = 6
                .MarkerBackgroundColorIndex = 46 ' 蓝色
                .MarkerForegroundColorIndex = xlAutomatic
            End With
        End If
    Next i
End Sub

步骤四：优化宏

我们还可以将突显功能进一步优化，增强其交互性。由于现在的宏需要不断地修改，来突显不同范围内的数据，这很繁琐。如果宏可以根据所选数据自动突显，那就更好了。

下面是更新后的宏，其可以实现更好的交互效果。用户只需要选择突显数据的范围，然后点击宏来实现突显功能。代码中通过使用选择的销售数据行来确定突显范围，然后逐个突显选定范围内的悬挂数据点。

Sub Highlight_Interactive()
    Dim SalesChart As ChartObject
    Dim SalesSeries As Series
    Dim SalesPoint As Point
    Dim SalesSheet As Worksheet
    Dim SalesTable As ListObject
    Dim StartRow As Long
    Dim EndRow As Long
    Dim SalesData As Variant
    Dim Count As Long
    Dim i As Long

    Set SalesSheet = ActiveWorkbook.Sheets("Sales Sheet")
    Set SalesTable = SalesSheet.ListObjects("Sales")
    Set SalesChart = SalesSheet.ChartObjects("Chart 1")
    Set SalesSeries = SalesChart.Chart.SeriesCollection(1)

    ' 获取选定区域的首尾行
    StartRow = Selection.Cells(1, 1).Row - 1
    EndRow = Selection.Cells(Selection.Rows.Count, 1).Row - 1

    ' 将所有点颜色和大小设置为默认
    For i = 1 To UBound(SalesTable.DataBodyRange.Value)
        Set SalesPoint = SalesSeries.Points(i)
        With SalesPoint
            .MarkerSize = 2.25
            .MarkerForegroundColorIndex = xlAutomatic
            .MarkerBackgroundColorIndex = xlAutomatic
        End With
    Next i

    ' 突显悬挂点
    SalesData= SalesSeries.Values
    For i = StartRow To EndRow
        If SalesData(i) < 40 Then ' 假设这些点为悬挂点
            Set SalesPoint = SalesSeries.Points(i)
            With SalesPoint
                .MarkerSize = 6
                .MarkerBackgroundColorIndex = RGB(46, 117, 181) ' 蓝色
                .MarkerForegroundColorIndex = xlAutomatic
            End With
            Count = Count + 1
        End If
    Next i

    If Count = 0 Then
        MsgBox ("No hanging point found in the selected range.")
    End If
End Sub