VBA检查Sparkline中数据点的数量
我有一个VBAmacros，它正在两个文件之间运行比较，并创build一个validation文件，列出这两个文件之间匹配或不匹配的数字。 我想知道是否有VBA来计算一个sparkline中的数据点的数量？ 我的迷你曲线应该总是有12个数据点，它们存在于另一个标签上。
我没有任何代码示例，因为我甚至不知道从哪里开始。 如果需要，我可以提供更多细节。
现在我明白你的意思了。 我误解了，因为我需要把它翻译成德文，我不是英文母语，所以我以为你在谈论一个普通的图表对象。
现在到真正的迷你游戏
不可能直接对数据点进行计数。 你唯一能做的就是validation数据源，看看它有多大（有多less个单元格）：
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中包含的空单元格。 所以这是一个certificate，如果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