Excel中具有各種Y值和一個X值的圖表VBA

Question

這是我用來創建圖表的代碼，它在指定的路徑中搜索.csv {使用excel應用程序}文件創建。它將列「B」{Y軸}與列「C」{X軸}繪製在一起。我想在我的Y軸上保留一列「A」，並將列「C」作爲X軸。我怎樣才能去做？？？

這裏是代碼...

Sub Draw_Graph() 
    Dim strPath As String 
    Dim strFile As String 
    Dim strChart As String 
    Dim i As Integer 
    Dim j As Integer 

    strPath = "C:\PortableRvR\report\" 
    strFile = Dir(strPath & "*.csv") 
    i = 1 

    Do While strFile <> "" 
     With ActiveWorkbook.Worksheets.Add 
      With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
       Destination:=.Range("A1")) 
       Parent.Name = Replace(strFile, ".csv", "") 
       TextFileParseType = xlDelimited 
       TextFileTextQualifier = xlTextQualifierDoubleQuote 
       TextFileConsecutiveDelimiter = False 
       TextFileTabDelimiter = False 
       TextFileSemicolonDelimiter = False 
       TextFileCommaDelimiter = True 
       TextFileSpaceDelimiter = False 
       TextFileColumnDataTypes = Array(1) 
       TextFileTrailingMinusNumbers = True 
       Refresh BackgroundQuery:=False 
       Files(i) = .Parent.Name 
       i = i + 1 
      End With 
     End With 
     strFile = Dir 
    Loop 

    numOfFiles = i - 1 
    chartName = "Chart 1" 

    For j = 1 To numOfFiles 
     strFile = Files(j) 
     Sheets(strFile).Select 
     Plot_y = Range("B1", Selection.End(xlDown)).Rows.Count 
     Plot_x = Range("C1", Selection.End(xlDown)).Rows.Count 

     Sheets("GraphDisplay").Select 
     If j = 1 Then ActiveSheet.ChartObjects(chartName).Activate 
     ActiveChart.SeriesCollection.NewSeries 
     ActiveChart.SeriesCollection(j).Name = strFile 
     ActiveChart.SeriesCollection(j).XValues = Sheets(strFile).Range("C1:C" & Plot_x) 
     ActiveChart.SeriesCollection(j).Values = Sheets(strFile).Range("B1:B" & Plot_y) 
     ActiveChart.SeriesCollection(j).MarkerStyle = -4142 
     ActiveChart.SeriesCollection(j).Smooth = False 
    Next j 

    ActiveSheet.ChartObjects(chartName).Activate 
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions 
    ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False 
End Sub 

Answer 1

您可以添加2系列的每個文件（j和j + 1內for j = 1 to 2*numOfFiles step 2）和重複家居J + 1系列不同的是：

ActiveChart.SeriesCollection(j).Values = Sheets(strFile).Range("A1:A" & Plot_y) 
ActiveChart.SeriesCollection(j+1).Values = Sheets(strFile).Range("B1:B" & Plot_y) 

Answer 2

不爲點

我打算張貼此作爲註釋（，因此不選擇此作爲回答。所有功勞歸於@Aprillion），但評論不會格式化代碼，因爲這篇文章會做。

每當你添加一個系列作爲Aprillion提到你還必須添加一行。我只用一小塊數據測試了它，它工作。

'<~~ You have to call this everytime you add a new series 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(1).Values = "=Sheet1!$B$1:$B$6" 
'<~~ You have to call this everytime you add a new series 
ActiveChart.SeriesCollection.NewSeries 
ActiveChart.SeriesCollection(2).Values = "=Sheet1!$A$1:$A$6" 

而且因爲有你係列1數據和2個系列數據（按快照）之間的巨大差異，第二個系列將非常接近X軸。

希望這是你想要的嗎？

隨訪

這就是你正在嘗試？

Dim files(1 To 20) As String 
Dim numOfFiles As Integer 
Dim chartName As String, shName as String 

Sub Time_Graph() 
    Dim strPath As String, strFile As String, strChart As String 
    Dim i As Long, j As Long, n As Long 

    strPath = "C:\PortableRvR\report\" 
    strFile = Dir(strPath & "*.csv") 

    i = 1 

    Do While strFile <> "" 
     With ActiveWorkbook.Worksheets.Add 
      shName = strFile 
      ActiveSheet.Name = Replace(shName, ".csv", "") 
      With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
       Destination:=.Range("A1")) 
       .Name = Replace(strFile, ".csv", "") 
       .TextFileParseType = xlDelimited 
       .TextFileTextQualifier = xlTextQualifierDoubleQuote 
       .TextFileConsecutiveDelimiter = False 
       .TextFileTabDelimiter = False 
       .TextFileSemicolonDelimiter = False 
       .TextFileCommaDelimiter = True 
       .TextFileSpaceDelimiter = False 
       .TextFileColumnDataTypes = Array(1) 
       .TextFileTrailingMinusNumbers = True 
       .Refresh BackgroundQuery:=False 
       files(i) = .Parent.Name 
       i = i + 1 
      End With 
     End With 
     strFile = Dir 
    Loop 

    numOfFiles = i - 1 
    chartName = "Chart 1" 

    For j = 1 To numOfFiles 
     If n = 0 Then n = j Else n = n + 2 
     strFile = files(j) 
     Sheets(strFile).Select 
     Plot_y = Range("B1", Selection.End(xlDown)).Rows.Count 
     Plot_x = Range("C1", Selection.End(xlDown)).Rows.Count 

     Sheets("GraphDisplay").Select 

     If j = 1 Then ActiveSheet.ChartObjects(chartName).Activate 

     ActiveChart.SeriesCollection.NewSeries 
     ActiveChart.SeriesCollection(n).Name = strFile & " - Col B Values" 
     ActiveChart.SeriesCollection(n).XValues = "=" & strFile & "!$C$1:$C$" & Plot_x 
     ActiveChart.SeriesCollection(n).Values = "=" & strFile & "!$B$1:$B$" & Plot_y 

     ActiveChart.SeriesCollection.NewSeries 
     ActiveChart.SeriesCollection(n + 1).Name = strFile & " - Col A Values" 
     ActiveChart.SeriesCollection(n + 1).XValues = "=" & strFile & "!$C$1:$C$" & Plot_x 
     ActiveChart.SeriesCollection(n + 1).Values = "=" & strFile & "!$A$1:$A$" & Plot_y 

     ActiveChart.SeriesCollection(j).MarkerStyle = -4142 
     ActiveChart.SeriesCollection(j).Smooth = False 
     ActiveChart.SeriesCollection(n + 1).MarkerStyle = -4142 
     ActiveChart.SeriesCollection(n + 1).Smooth = False 
    Next j 

    ActiveSheet.ChartObjects(chartName).Activate 
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions 
    ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False 
End Sub