[已解决]VBA 如何自动识别单元格数量，并递增执行此命令？

试验资料

Private Sub worksheet_change(ByVal target As Range)


    ActiveSheet.ChartObjects("图表 4").Activate
    ActiveChart.SeriesCollection(2).Points(1).DataLabel.Select
    Selection.Characters.Text = [e15]
    ActiveSheet.ChartObjects("图表 4").Activate
    ActiveChart.SeriesCollection(2).Points(2).DataLabel.Select
    Selection.Characters.Text = [f15]
    ActiveSheet.ChartObjects("图表 4").Activate
    ActiveChart.SeriesCollection(2).Points(3).DataLabel.Select
    Selection.Characters.Text = [g15]
End Sub
如上所示，我想让表格collection(2).points(1)改成collection(2).points(x)，其中x从1往上递增，同时[E15]也跟着递增，有简单指令吗？
还有，如果用for x =1 to n指令，这个n可否自动取非空单元格的数量？求大神指教，小弟不胜感激！

最佳答案

月排行榜 / 总排行榜

爱疯

2016-1-21 19:13

(, 下载次数: 11)

上传

点击文件名下载附件


对此，03和03以后版本肯定是有区别的。
比如，我在10下试着没报错，而03下报错。


具体的原因，我不知道。
第2个系列的前7个数据点都正常，到了第8个就出错：无法引用其数据标签（DataLabel 对象）。
现在试了半天，又和这个动画中的情况，不一样了。。。。




(, 下载次数: 2)

上传

点击文件名下载附件

不管原因究竟是什么，保存时应尽量避免出现这样的提示。
因为我觉得这样的提示，可能是将来发生的怪问题的隐患。
比如，提示“统一数据”工作表里张有2处有问题，和数据验证规则有关。

跳转到最佳答案楼层

爱疯

1楼代码可改为循环

Private Sub worksheet_change(ByVal target As Range)
    Call test
End Sub

Sub test()
    With ActiveSheet.ChartObjects("图表 4").Chart.SeriesCollection(2)
        For i = 1 To 3
            .Points(i).DataLabel.Characters.Text = Cells(15, i + 4)
        Next i
    End With
End Sub

试验资料

爱疯 发表于 2016-1-21 13:57
1楼代码可改为循环

Private Sub worksheet_change(ByVal target As Range)

万分感谢，果然厉害，我想再问一下，其中for i = 1 to 3 这个3是否可以换成一个统计数，自动统计15行第5列到14列的数字单元格数量，比如附件中的就有7个数，怎么写函数？

爱疯

Private Sub worksheet_change(ByVal target As Range)
    Call test
End Sub

Sub test()
    Dim i As Integer
    Dim rng As Range

    With ActiveSheet.ChartObjects("图表 4").Chart.SeriesCollection(2)
        For i = 1 To 10
            Set rng = Cells(15, i + 4)
            If VBA.IsNumeric(rng) Then .Points(i).DataLabel.Characters.Text = rng Else Exit For
        Next i
    End With
End Sub

试验资料

爱疯 发表于 2016-1-21 14:38
Private Sub worksheet_change(ByVal target As Range)
    Call test
End Sub

谢谢，好像看明白了

试验资料

爱疯 发表于 2016-1-21 14:38
Private Sub worksheet_change(ByVal target As Range)
    Call test
End Sub

还有件麻烦事
Private Sub worksheet_change(ByVal target As Range)
    ActiveSheet.ChartObjects("图表 4").Chart.Axes(xlCategory).MaximumScale = [i33]
    Call test
End Sub
Sub test()
    Dim i As Integer
    Dim rng As Range
    With ActiveSheet.ChartObjects("图表 4").Chart.SeriesCollection(2)
        For i = 1 To 10
            Set rng = Cells(15, i + 4)
            If VBA.IsNumeric(rng) Then .Points(i).DataLabel.Characters.Text = rng Else Exit For
        Next i
    End With
End Sub
我加了句 ActiveSheet.ChartObjects("图表 4").Chart.Axes(xlCategory).MaximumScale = [i33]
这个，如果附件里的第一个表格更改级配属性，为什么报告表不自动更换呢，如原来的是37.5,31.5...更改为53.37.5,31.5...第一个表改动，报告表的图表不自动更改啊

试验资料

试验资料 发表于 2016-1-21 15:12
还有件麻烦事
Private Sub worksheet_change(ByVal target As Range)
    ActiveSheet.ChartObjects("图 ...

这是新的附件

爱疯

Private Sub Worksheet_Activate()
    Call test
End Sub

Sub test()
    Dim i As Integer
    Dim rng As Range
    With ActiveSheet.ChartObjects("图表 4").Chart
        .Axes(xlCategory).MaximumScale = [i33]
        For i = 1 To 10
            Set rng = Cells(15, i + 4)
            If VBA.IsNumeric(rng) Then .SeriesCollection(2).Points(i).DataLabel.Characters.Text = rng Else Exit For
        Next i
    End With
End Sub
水泥混凝土用粗集料试验检测报告记录2.rar (30.27 KB, 下载次数: 11)

2016-1-21 16:39 上传

点击文件名下载附件

试验资料

爱疯 发表于 2016-1-21 15:43
Private Sub Worksheet_Activate()
    Call test
End Sub

有时间的话，QQ教我下行吗？

爱疯

刚才附件发错，已加。