次轴未绘制值

Question

我有一个序列号列表，其中包含运行次，我试图通过组合图在 excel 中绘制图表，然后将其推送到 PowerPoint。我正在使用数组操作来获取图表的数据，设置 3 seriescollections 并尝试在带有计数的条形图中获取序列号，然后是关联 [=26= 的持续时间（平均和总计）的线图] 次。数据正在进入图表，select 数据 window 中的值是正确的。每个系列还在图表的 select 数据 window 中分配了正确的 axisgroup（主要或次要）。知道为什么两条线的标绘点都是“0”吗（双击图表上的数据点也表示值为 0）？

我正在调暗 stuff() 作为变体。我知道这是不对的。我应该将它们调暗为 arr() of type 或 arr as variant。 IDK 为什么当我以另一种方式做时它会破坏我，但确实如此。我也听说了。哈哈。我感谢任何帮助！！！！

在@FaneDuru 的帮助下更新了代码：

Option Explicit



Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, _
Optional lngColumn As Long = 0)
    On Error Resume Next
    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long
    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If
    i = lngMin
    j = lngMax
    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)
    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If
    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend
        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp
            i = i + 1
            j = j - 1
        End If
    Wend
    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
End Sub

Private Function contArrayFromDscRng(rng As Range) As Variant 'makes 2D array from a discontinuous range i.e. filtered worksheet
    Dim a As Range, arr, count As Long, i As Long
    
    ReDim arr(1 To rng.Cells.count, 1 To 1): count = 1
    For Each a In rng.Areas
            For i = 1 To a.Cells.count
                arr(count, 1) = a.Cells(i).Value: count = count + 1
            Next
    Next
    contArrayFromDscRng = arr
End Function

Function GetUniqueDict(arr As Variant) As Variant

   Dim dict As Object, i As Long
   Set dict = CreateObject("Scripting.Dictionary")
   
   For i = LBound(arr) To UBound(arr)
        dict(arr(i, 1)) = 1
   Next i
   GetUniqueDict = dict.Keys
End Function

Answer 1

请使用下一个函数从不连续的范围构建一个连续的数组：

Private Function contArrayFromDscRng(rng As Range) As Variant 'makes 2D array from a discontinuous range
    Dim a As Range, arr, count As Long, i As Long
    
    ReDim arr(1 To rng.cells.count, 1 To 1): count = 1
    For Each a In rng.Areas
            For i = 1 To a.cells.count
                arr(count, 1) = a.cells(i).value: count = count + 1
            Next
    Next
    contArrayFromDscRng = arr
End Function

您可以在您的代码中使用它：

serialNum = contArrayFromDscRng(rng)

下一个函数将从另一个数组中提取一个唯一值数组：

Function GetUniqueDict(arr As Variant) As Variant
   Dim dict As Object, i As Long
   Set dict = CreateObject("Scripting.Dictionary")
   For i = LBound(arr) To UBound(arr)
        dict(arr(i, 1)) = 1
   Next i
   GetUniqueDict = dict.Keys
End Function

但它会return一个一维数组。它也可以用作图表的数据源。

但是如果您喜欢处理二维数组的方式，您可以轻松地转换 returned 的一维数组。在函数内部，或外部。像这样：

  Dim arr
  arr = GetUniqueDict(serialNum)
  
  'transform it as a 2D array:
  Dim i As Long
  ReDim serialNum(1 To UBound(arr) + 1, 1 To 1)
  For i = 0 To UBound(arr)
    serialNum(i + 1, 1) = arr(i)
  Next i

次轴未绘制值

Secondary axis not graphing values

excel

vba

graph