Question

这是代码：

Sub Charter()

Rows("1:3").Delete
Columns(1).EntireColumn.Delete
Columns("A").Insert
Columns("C").Copy Columns("A")
Columns("C").Delete

With Range("A:A")
    .Value = Evaluate(.Address & "*25.51")
End With

With Range("B:B")
    .Value = Evaluate(.Address & "*50")
End With
With Range("D:D")
    .Value = Evaluate(.Address & "*30.12")
End With



Dim rngDataSource As Range
Dim iDataRowsCt As Long
Dim iDataColsCt As Integer
Dim iSrsIx As Integer
Dim chtChart As Chart
Dim srsNew As Series

Columns("A:D").Select
If Not TypeName(Selection) = "Range" Then
    '' Doesn't work if no range is selected
    MsgBox "Please select a data range and try again.", _
        vbExclamation, "No Range Selected"
Else
    Set rngDataSource = Selection
    With rngDataSource
        iDataRowsCt = .Rows.Count
        iDataColsCt = .Columns.Count
    End With
    If iDataColsCt Mod 2 > 0 Then
        MsgBox "Select a range with an EVEN number of columns.", _
            vbExclamation, "Select Even Number of Columns"
        Exit Sub
    End If

    '' Create the chart
    Set chtChart = ActiveSheet.ChartObjects.Add( _
        Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
            ActiveWindow.Width / 4, _
        Width:=ActiveWindow.Width / 2, _
        Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
            ActiveWindow.Height / 4, _
        Height:=ActiveWindow.Height / 2).Chart

    With chtChart
        .ChartType = xlXYScatterSmoothNoMarkers

        '' Remove any series created with the chart
        Do Until .SeriesCollection.Count = 0
            .SeriesCollection(1).Delete
        Loop

        For iSrsIx = 1 To iDataColsCt - 1 Step 2
            '' Add each series
            Set srsNew = .SeriesCollection.NewSeries
            With srsNew
                .Name = rngDataSource.Cells(1, iSrsIx + 1)
                .Values = rngDataSource.Cells(2, iSrsIx + 1) _
                    .Resize(iDataRowsCt - 1, 1)
                .XValues = rngDataSource.Cells(2, iSrsIx) _
                    .Resize(iDataRowsCt - 1, 1)
            End With
        Next
    End With
End If
End Sub

由于此代码的前几行（用于更改现有的Excel工作表格式），应该有4列A，B，C和D.我试图将列B，C和D与列A作为x轴绘制图形。但是我现在的结果只显示了2个系列而不是3个系列，而且似乎错误了。逻辑中的错误是什么？

Answer 1

由于您希望第一列成为X轴，并将第二列，第三列和第四列作为每个系列的值，首先声明以下附加变量...

Dim rngChrtXVals as Range

然后修改您的With/End With声明，如下所示......

With chtChart
    .ChartType = xlXYScatterSmoothNoMarkers

    '' Remove any series created with the chart
    Do Until .SeriesCollection.Count = 0
        .SeriesCollection(1).Delete
    Loop

    Set rngChrtXVals = rngDataSource.Cells(2, 1) _
        .Resize(iDataRowsCt - 1, 1)

    For iSrsIx = 2 To iDataColsCt
        '' Add each series
        Set srsNew = .SeriesCollection.NewSeries
        With srsNew
            .Name = rngDataSource.Cells(1, iSrsIx)
            .Values = rngDataSource.Cells(2, iSrsIx) _
                .Resize(iDataRowsCt - 1, 1)
            .XValues = rngChrtXVals
        End With
    Next
End With

希望这有帮助！

Answer 2

您正在寻找逻辑中的错误。就是这样：

With Range("A:A")
    .value = Evaluate(.Address & "*25.51")
End With

您对这三行的期望是什么？如果可能，请在问题中提供屏幕截图。

以下是如何使它有点可行。 - 打开一个新的工作簿 - 在A列中写一些随机值 - 逐行运行TestMe代码（使用F8）

Option Explicit

Public Sub TestMe()

    Dim lngFirstLine    As Long
    Dim lngLastLine     As Long
    Dim rngCell         As Range

    lngFirstLine = 1
    lngLastLine = lastRow(ActiveSheet.Name, 1)

    With ActiveSheet
        For Each rngCell In .Range(.Cells(lngFirstLine, 1), .Cells(lngLastLine, 1))
            rngCell = rngCell * 25.51
        Next rngCell
    End With

End Sub

Function lastRow(Optional strSheet As String, Optional column_to_check As Long = 1) As Long

    Dim shSheet  As Worksheet

        If strSheet = vbNullString Then
            Set shSheet = ActiveSheet
        Else
            Set shSheet = Worksheets(strSheet)
        End If

    lastRow = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row

End Function

Answer 3

.XValues范围和值范围不正确。

    For iSrsIx = 2 To iDataColsCt Step 1
        '' Add each series
        Set srsNew = .SeriesCollection.NewSeries
        With srsNew
            .Name = rngDataSource.Cells(1, iSrsIx)
            .Values = rngDataSource.Cells(2, iSrsIx) _
                .Resize(iDataRowsCt - 1, 1)
            .XValues = rngDataSource.Cells(2, 1) _
                .Resize(iDataRowsCt - 1, 1)
        End With
    Next

VBA图形错误

3 个答案: