VBAgraphics错误

这是代码：

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

.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

既然你希望你的第一列是你的X轴，你的第二，第三和第四列是你的每个系列的值，首先声明下面的附加variables…

 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 3

您正在查找逻辑中的错误。 就是这个：

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

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

---

这是如何使它有点可行。 – 打开一个新的工作簿 – 在列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