关于在图表中隐藏零值的问题

Posted 2021-05-05

这次我写了我的宏。但它仍然没有奏效。我想设计一个宏，它可以检测图中的任何零值（在y轴上），然后隐藏相关的x轴点。这是宏。

Sub Delete0()

    ActiveSheet.ChartObjects("YYY").Activate
    For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
        If ActiveChart.FullSeriesCollection(1).Points(x).DataLabels.Count = 0 Then
            ActiveChart.ChartGroups(1).FullCategoryCollection(x).IsFiltered = True
        End If
    Next x

End Sub

答案

因此，如果您隐藏源数据中Y = 0的行，则这些点将不会在图表上绘制。

如果您的数据设置为Excel表并且在执行过滤器时使用宏录制器，则这很容易。这将为您提供开始代码：

然后将进行一些研究：

Autofilter

和

ListObject

你可以调整代码，并有类似的东西：

Option Explicit

Sub HideCharts()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim targetTable As ListObject

    Set wb = ThisWorkbook
    Set wsData = wb.Worksheets("Sheet1")
    Set targetTable = wsData.ListObjects("Table1")

    'Check that there are other values apart from 0 so don't try to filter to nothing
    If Application.WorksheetFunction.CountIf(targetTable.DataBodyRange.Columns(2), ">" & 0) > 0 Then ' DataBodyRange.Columns(2) = y column

        With targetTable.Range

           .AutoFilter Field:=2 'remove filter
           .AutoFilter Field:=2, Criteria1:="<>0", Operator:=xlFilterValues

        End With

    End If


End Sub

版本2绘制图表系列以忽略零（需要一些精炼）。

现有图表，然后使用工作表中的数据向其添加系列（X和Y）。

将工作表数据加载到数组中，循环并连接非零值。使用我调整过的@Aiken函数拆分这些字符串以创建数组，以确保绘制为系列源的数组是整数而不是文本。使用Split$返回不会以所需方式绘制的字符串。随着时间的推移，我会进一步调整它以使用Long来避免溢出。如果使用，我会这样做。我相信，就目前而言，这说明了你所追求的原则。

Option Explicit

Public Sub AddSeriesWithoutZero()

    Dim myChart As Chart

    Set myChart = ActiveSheet.ChartObjects("Chart 1").Chart

    Dim sourceData()

    sourceData = ActiveSheet.Range("A2:B5").Value

    Dim currRow As Long
    Dim textStringY As String
    Dim textStringX As String

    For currRow = LBound(sourceData, 1) To UBound(sourceData, 1)

        If Not sourceData(currRow, 2) = 0 Then

            textStringY = textStringY & CStr(sourceData(currRow, 2)) & ";"
            textStringX = textStringX & CStr(sourceData(currRow, 1)) & ";"

        End If

    Next currRow

    Dim arrayY() As Integer
    arrayY = SplitIntegers(textStringY, ";")

    Dim arrayX() As Integer
    arrayX = SplitIntegers(textStringX, ";")


    With myChart.SeriesCollection.NewSeries
             .XValues = arrayX  'xaxis
             .Values = arrayY  'yaxis
    End With

End Sub

Public Function SplitIntegers(ByVal StringToSplit As String, ByVal Sep As String) As Variant

    Dim arrStrings() As String
    Dim arrIntegers() As Integer
    Dim i As Long

    On Error GoTo Err_SplitIntegers
    arrStrings = Split$(StringToSplit, Sep)
    ReDim arrIntegers(LBound(arrStrings) To UBound(arrStrings) - 1)

    For i = LBound(arrStrings) To UBound(arrStrings) - 1 
        arrIntegers(i) = CInt(arrStrings(i))
    Next i

    SplitIntegers = arrIntegers
    Exit Function

Err_SplitIntegers:
    Select Case Err.Number
        Case 13 'Type Mismatch Error: StringToSplit contains non-numeric substrings
            On Error GoTo 0
            Err.Raise 9114, "SplitIntegers", _
                      "SplitIntegers failed: substring '" & arrStrings(i) & "' of string '" & StringToSplit & "' is not numeric"
        Case Else 'Unhandled error, return to calling code
            Dim iErrNum As Integer, strErrDesc As String
            iErrNum = Err.Number
            strErrDesc = Err.Description
            On Error GoTo 0
            Err.Raise iErrNum, "SplitIntegers", strErrDesc
    End Select
End Function

结果：