VBA图形错误

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 

有应该是4列A，B，C和d作为该代码的第几行的结果（用于改变一个现有Excel表格格式）。我正在尝试将列B，C和D对照列A作为x轴。但是我现在的结果只显示了2个系列而不是3个，而且看起来是轴错了。逻辑中的错误是什么？

Answer 1

.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 

Answer 2

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

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

你对这3行的期望是什么？如果可能的话，在你的问题中提供截图。

---

这是如何使它有点可行。 - 打开一个新的工作簿 - 在A列写几个随机值 - （使用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

因为你希望你的第一列是你的X轴运行由线TestMe代码行，你的第二，第三和第四列是你的价值观为每个系列，首先声明以下额外的变量...

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 

希望这有助于！