Question

我需要在Excel中使用VBA获取范围内的每个奇数行（在我的例子中，范围是RngList）。这是我的代码，它出了一个空白的图表：

Sub Chart()
Dim myData As String, sh As String
Dim LastRow As Long
Dim Rng As Range
Dim RngList As Range

With ActiveSheet
     LastRow = .Range("C" & .Rows.count).End(xlUp).Row - 2
     Set RngList = .Range("D1:U" & LastRow & ", C2:C" & LastRow)
     Set Rng = RngList(1)
     For CurRow = 3 To LastRow - 1 Step 2
        Set Rng = Union(Rng, RngList(CurRow))
     Next CurRow
End With

sh = ActiveSheet.Name
Charts.Add
ActiveChart.ChartType = xlLine

ActiveChart.SetSourceData Source:=Rng, PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:=sh
ActiveChart.SeriesCollection(1).XValues = Range("C2:C" & LastRow)

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "PVC MIXER"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "BATCH NUMBER"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "WEIGHT"
End With

ActiveChart.ChartArea.Select

Set Rng = Nothing
Set RngList = Nothing
End Sub

Answer 1

试试这个对我有用的。

Sub marine()
    Dim sh As Worksheet: Set sh = ActiveSheet
    Dim lr As Long, RngList As Range, rng As Range
    With sh
        lr = .Range("C" & .Rows.Count).End(xlUp).Row - 2
        Set RngList = .Range("C2:C" & lr)
        Set rng = RngList(1).Resize(, 19) 'resize until Column U

        Dim c As Range
        For Each c In RngList
            If c.Row Mod 2 = 1 Then
                Set rng = Union(rng, c.Resize(, 19))
            End If
        Next

        Dim ch As Chart
        Set ch = .Shapes.AddChart2(, xlLine).Chart
        With ch
            .SetSourceData rng
            .HasTitle = True
            .ChartTitle.Characters.Text = "PVC MIXER"
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "BATCH NUMBER"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "WEIGHT"
        End With
    End With
End Sub

Answer 2

我认为您需要允许以null范围开头：

With ActiveSheet
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row - 2
    Set RngList = .Range("D1:U" & LastRow & ", C2:C" & LastRow)
    Set rng = RngList(1)
    For CurRow = 3 To LastRow - 1 Step 2
       If Not rng Is Nothing Then
           Set rng = Union(rng, RngList(CurRow))
       Else
           Set rng = RngList(CurRow)
       End If
    Next CurRow
End With

使用VBA获取范围内的奇数行

2 个答案: