Question

我有一个VBA宏，它运行两个文件之间的比较并创建一个验证文件，列出两个文件之间的数字是匹配还是不匹配。我想知道VBA是否有计算迷你线中数据点的数量？我的迷你图应始终有12个数据点，这些数据点存在于另一个选项卡上。

我没有任何代码示例，因为我甚至不知道从哪里开始。如果需要，我可以提供更多细节。

Answer 1

现在我明白了你对迷你线的意思。我误解了，因为我需要把它翻译成德语，我不是母语，所以我以为你在谈论一个普通的图表对象。

现在真正的迷你
不可能直接计算数据点。您唯一能做的就是验证数据源，看看它有多大（多少个单元格）：

Public Sub CountSparklineDataPoints()
    Dim oSparkGroup As SparklineGroup

    With Worksheets("Sheet1")
        For Each oSparkGroup In ActiveSheet.Columns("A").SparklineGroups 'all sparklines in column A are processed
            .Range(oSparkGroup.Item(1).Location.Address).Offset(0, 4) = .Range(oSparkGroup.Item(1).SourceData).Cells.Count
            'write 4 columns right of the sparkline                   = the count of the cells in sourcedata
        Next oSparkGroup
    End With
End Sub

请注意，这也会计算SourceData中包含的空单元格。因此，如果SourceData大小正确，这是一个证据。

对于外部地址，这将更广泛：

Public Sub CountSparklineDataPoints()
    Dim oSparkGroup As SparklineGroup

    With Worksheets("Sheet1")
        For Each oSparkGroup In ActiveSheet.Columns("E").SparklineGroups 'all sparklines in column A are processed
            .Range(oSparkGroup.Item(1).Location.Address).Offset(0, 4) = RangeFromAddress(oSparkGroup.Item(1).SourceData).Cells.Count
            'write 4 columns right of the sparkline                   = the count of the cells in sourcedata
        Next oSparkGroup
    End With
End Sub


'================================
' VBA Get Range from address string
'
' http://www.exceltoolset.com
'================================
Function RangeFromAddress( _
 ByRef Address As String, _
 Optional obj As Object) As Range
    Dim Wb As Workbook, FallbackWb As Workbook
    Dim sh As Worksheet, FallbackSh As Worksheet
    Dim w, s, a As String
    Dim i As Long, j As Long
    Dim n As Name

    On Error Resume Next

    Set n = Names(Address)
    If Not (n Is Nothing) Then
        Set RangeFromAddress = n.RefersToRange
        Exit Function
    End If

    If Not (obj Is Nothing) Then
        Set FallbackWb = GetObjectParentWorkbook(obj)
        Set FallbackSh = GetObjectParentSheet(obj)
    Else
        Set FallbackWb = ActiveWorkbook
        Set FallbackSh = ActiveSheet
    End If

    i = InStr(Address, "!")
    If i = 0 Then
        Set RangeFromAddress = FallbackSh.Range(Address)
    Else
        s = Left$(Address, i - 1)
        a = Mid$(Address, i + 1)
        If InStr(s, "'") = 1 Then
            s = Mid$(s, 2, Len(s) - 2)
        End If

        i = 1
        Do Until i > Len(s)
            If Mid$(s, i, 2) = "''" Then
                s = Left$(s, i - 1) & Mid$(s, i + 1)
            End If
            i = i + 1
        Loop

        i = InStr(s, "]")
        If i = 0 Then
            Set sh = FallbackWb.Sheets(s)
        Else
            w = Left$(s, i - 1)
            j = InStr(w, "[")
            If j <> 0 Then w = Left$(w, j - 1) & Mid$(w, j + 1)
            s = Mid$(s, i + 1)

            Set Wb = Workbooks(w)
            If Wb Is Nothing Then
                Application.DisplayAlerts = False
                Set Wb = Workbooks.Open(Filename:=w, Notify:=True)
                Application.DisplayAlerts = True
            End If
            Set sh = Wb.Sheets(s)
        End If
        Set RangeFromAddress = sh.Range(a)
    End If
End Function

Function GetObjectParentWorkbook(aObject As Object) As Workbook
    Dim o As Object

    On Error GoTo ErrorHandle

    If aObject Is Nothing Then GoTo ErrorExit
    Set o = aObject.Parent

    If TypeOf aObject Is Workbook Then
        Set GetObjectParentWorkbook = aObject
        GoTo ErrorExit
    End If

    Do Until (TypeOf o Is Workbook) Or (TypeOf o Is Application)
        Set o = o.Parent
    Loop

    If TypeOf o Is Workbook Then Set GetObjectParentWorkbook = o

ErrorExit:
    Exit Function

ErrorHandle:
    Resume ErrorExit
End Function

Function GetObjectParentSheet(aObject As Object) As Object
    Dim op As Object
    On Error Resume Next

    If aObject Is Nothing Then GoTo ErrorExit
    Set op = aObject.Parent
    If op Is Nothing Then GoTo ErrorExit

    If TypeOf op Is Workbook Then
        Set GetObjectParentSheet = aObject
        GoTo ErrorExit
    End If

    Do Until (TypeOf op Is Worksheet) Or (TypeOf op Is Application)
        Set op = op.Parent
    Loop

    If TypeOf op Is Worksheet Then Set GetObjectParentSheet = op

ErrorExit:
    Exit Function
End Function

VBA检查迷你图中的数据点数

1 个答案: