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 

希望這有助於！