Question

这是我的问题。我设法创建了一个如下所示的宏：

Sub Macro1()
   Range("G17:G36").Select
   ActiveSheet.Shapes.AddChart.Select
   ActiveChart.SetSourceData Source:=Range("'Sheet1'!$G$17:$G$36")
   ActiveChart.ChartType = xlLine
End Sub

我知道这是非常基本的记录，但我的问题是如何改变它并使范围动态和有条件。例如，当我到达第17行时，我在单元格D17中的值大于200，而E17中的值大于100.这应该触发我的范围的开始。因此，如果D17>200 AND E17>100我需要G17作为范围的开头。至于G36（范围的结尾）逻辑是非常相似的，但这次我会测试这样的条件：IF F36<64 THEN得到G36作为范围的结束。应该重复到最后。例如，最后一行可能是28000，所以我希望在此过程中创建这些图表中的一小部分。

谢谢你的帮助，薛定谔。

这就是它现在的样子，并在我与EngJon的通信中解释了一个运行时错误。

Sub GenerateCharts()
    Application.ScreenUpdating = False
    'Get the last row
    Dim LastRow As Long
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Dim endOfRange As Long
    Dim wholeRange As Range
    Dim i As Long
    For i = 1 To LastRow
        If Cells(i, 4) > 0.000001 And Cells(i, 5) > 0.00000002 Then
            'Determine the end of the range
            endOfRange = DetermineRange(i)
            Set wholeRange = Range(Cells(i, 7), Cells(endOfRange, 7))
            NewChart (wholeRange)
            i = endOfRange
        End If
    Next i

    Application.ScreenUpdating = True
End Sub
Function DetermineRange(row As Long) As Long
    Dim LastRow As Long
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Dim j As Long
    For j = row To LastRow
        If Cells(j, 6) < -0.0000000018 Then
            DetermineRange = j
            Exit Function
        End If
    Next j
    DetermineRange = j
End Function
Function NewChart(rng As Range)
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=rng
    ActiveChart.ChartType = xlLine
End Function

这是我的最终解决方案。我希望它对某人有帮助。对于EngJon和Paagua Grant来说很重要。

Sub GenerateCharts()
    Application.ScreenUpdating = False
    Dim StartCell As Long
    Dim EndCell As Long
    Dim ChartRange As Range
    Dim DataEnd As Long
    Dim i As Integer
    Dim j As Integer
    Dim HasStart As Boolean
    Dim HasEnd As Boolean
    'Sets end of data based on the row you are charting
    DataEnd = Cells(Rows.Count, 7).End(xlUp).Row
    'Begin loop to find start and end ranges, create charts based on those ranges
    For i = 1 To DataEnd
        If HasStart Then
            If Cells(i, 4).Value < 0 Then
                EndCell = i
                HasEnd = True
            End If
        Else 'If there isn't a starting cell yet
            If Cells(i, 4).Value > 0.000001 And Cells(i, 5).Value > 0.00000002 Then
                StartCell = i
                HasStart = True
            End If
        End If
        If HasStart And HasEnd Then
            Set ChartRange = ActiveSheet.Range(Cells(StartCell, 7), Cells(EndCell, 7))
            ActiveSheet.Shapes.AddChart(xlLine, _
                                        Left:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 10)).Left, _
                                        Top:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 10)).Top, _
                                        Width:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 20)).Width, _
                                        Height:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell + 25, 10)).Height _
                                        ).Select
            ActiveChart.SetSourceData Source:=ChartRange
            HasStart = False
            HasEnd = False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Answer 1

您可以将录制的Macro1用作函数，并在需要创建新图表时调用它：

Function NewChart(rng As Range)
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=rng
    ActiveChart.ChartType = xlLine
End Function

您还需要以下功能：

Function DetermineRange(row As Long) As Long
    Dim LastRow As Long
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Dim j As Long
    For j = row To LastRow
        If Cells(j, 6) < 64 Then
            DetermineRange = j
            Exit Function
        End If
    Next j
    DetermineRange = j
End Function

您将在Sub中调用它来迭代所有行：

Sub GenerateCharts()
    Application.ScreenUpdating = False
    'Get the last row
    Dim LastRow As Long
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Dim endOfRange As Long
    Dim wholeRange As Range
    Dim i As Long
    For i = 1 To LastRow
        If Cells(i, 4) > 200 And Cells(i, 5) > 100 Then
            'Determine the end of the range
            endOfRange = DetermineRange(i)
            Set wholeRange = Range(Cells(i, 7), Cells(endOfRange, 7))
            NewChart wholeRange
            i = endOfRange
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

将这三个复制到模块中并执行Sub。请评论这是否符合您的要求。

Answer 2

这是一个稍微不同的选项，可以在一个函数中执行所有任务。

    Option Explicit

    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False

    Dim StartCell As Long, EndCell As Long, ChartRange As Range, DataEnd As Long, i As Integer, j As Integer, HasStart As Boolean, HasEnd As Boolean, _
        ChartTop As Long, ChartHeight As Long


    DataEnd = Cells(Rows.Count, 7).End(xlUp).Row 'Sets end of data based on the row you are charting.


    ChartTop = 50
    ChartHeight = 100

'Begin loop to find start and end ranges, create charts based on those ranges.
    For i = 1 To DataEnd
        If HasStart Then
                If Cells(i, 6).Value < 64 Then
                    EndCell = i
                    HasEnd = True
                End If
            Else 'If there isn't a starting cell yet.
                If Cells(i, 7).Value > 200 And Cells(i, 5).Value > 100 Then
                    StartCell = i
                    HasStart = True
                End If
        End If
        If HasStart And HasEnd Then
            Set ChartRange = ActiveSheet.Range(Cells(StartCell, 7), Cells(EndCell, 7))
            ActiveSheet.Shapes.AddChart(Top:=ChartTop, Height:=ChartHeight).Select
                With ActiveChart
                    .SetSourceData Source:=ChartRange
                    .ChartType = xlLine
                End With
            ChartTop = ChartTop + ChartHeight + 15

            HasStart = False
            HasEnd = False
        End If
    Next

    Application.ScreenUpdating = True

    End Sub

这也可以确保该工具创建的每个图表都不会与之前的图表重叠。

为了空间和清晰度，我在这里回答你的后续问题。

假设标准行高和列宽，您可以设置

ChartTop =(StartCell-1)*15

将图表的顶部设置为与数据位于同一行的顶部，并在

中

ActiveSheet.Shapes.AddChart(Top:=ChartTop, Height:=ChartHeight).Select

你可以添加

Left:=(X * 48)

其中X小于您希望图表左对齐的列号，例如如果你想让图表从第一列的左边缘开始，X将等于8.但是，据我所知，如果您的行高/列宽为非，则没有简单的方法可以调整这些值标准，例如如果您已将列自动调整为数据。

如何使用VBA

2 个答案: