Question

这是我用来创建图表的代码，该图表在指定的路径中搜索.csv {使用excel application}创建的文件。它将列'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系列数据之间存在巨大差异（根据快照），第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

Excel VBA中具有各种Y值和一个X值的图形

2 个答案: