将数据添加到散点图中,每个散点图都有自己的x轴范围

时间:2013-07-08 03:00:38

标签: excel excel-vba charts unique-constraint vba

在添加设置系列x轴范围的线之前,可以选择并绘制任何文件组合。使用该行('* * * *在末尾)如果在下一组要绘制的文件中选择了已在图上的文件,则除了新组中的第一个文件之外,还会发生错误。如果该行被评论,问题就会消失。如果没有每个系列都有自己的x轴值,则某些数据不能正确绘制(也有一个示例csv文件)。正在绘制的文件是170kB csv文件。可以提供工作表和文件。

Sub GetDataAndDisplayChart()
  Dim vFile, vFiles
  Dim iFirst As Integer
  Dim lRow As Long
  Dim rXValues As Range
  Dim rYValues As Range
  Dim iSer As Integer
  Dim WkShName As String
  Dim StartWkShCnt As Integer
  StartWkShCnt = Worksheets.Count
  ' get a set of CSV files to chart
  vFiles = Application.GetOpenFilename("csv files (*.csv), *.csv", , "Select files to chart", , True)
  If TypeName(vFiles) = "Boolean" Then Exit Sub
  Application.ScreenUpdating = False
  iFirst = ThisWorkbook.Sheets.Count + 1
  ' import each selected CSV file to a new sheet in this workbook
  For Each vFile In vFiles
    Workbooks.OpenText vFile, xlWindows, DataType:=xlDelimited, comma:=True
    ' move the sheet into this workbook
    ActiveSheet.Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  Next
  Worksheets(iFirst).Select
  Application.ScreenUpdating = True
  ' confirm the range to plot
  Set rXValues = Range("$A$3:$A$10002")
  Set rYValues = Range("$B$3:$B$10002")
  Worksheets("Chart").Select
  With Worksheets("Chart").ChartObjects(1).Chart
    ' add the first set of data to the existing chart (can have problems if you delete the old data first)
    .SeriesCollection.Add Union(rXValues, rYValues), serieslabels:=True, categorylabels:=True, Replace:=True
    .SeriesCollection(.SeriesCollection.Count).Name = Worksheets(iFirst).Range("A1")
    ' delete the old curves that were already on the chart
    For iSer = .SeriesCollection.Count - 1 To 1 Step -1
      .SeriesCollection(iSer).Delete
    Next
    ' add the new data from the addtional files
    For iSer = iFirst + 1 To Worksheets.Count
      .SeriesCollection.Add Worksheets(iSer).Range(rYValues.Address)
      WkShName = Worksheets(iSer).Name
      .SeriesCollection(iSer - StartWkShCnt).XValues = "= " & WkShName & "!" & rXValues.Address   '****
      .SeriesCollection(.SeriesCollection.Count).Name = Worksheets(iSer).Range("A1")
    Next
  End With
  ' delete the older worksheets that were already here
  Application.DisplayAlerts = False
  For iSer = iFirst - 1 To 1 Step -1
    If Worksheets(iSer).Name <> "Chart" Then Worksheets(iSer).Delete
  Next
End Sub

0 个答案:

没有答案
相关问题