在多个工作表中使用Excel中的VBA进行散点图

时间:2017-10-16 14:05:09

标签: excel vba excel-vba

我正在处理一个宏,它会转到我工作簿中的每个工作表,清理数据(添加列,更改单位等等)。在没有问题的情况下清理数据后,我试图在工作表上创建一个散点图。下面的代码遗漏了清理内容,因为它无关紧要。我尝试过多次迭代,包括记录宏,这是我最后一次尝试。最初来自单独的Excel文件的工作表产生了一个问题。每个工作表都具有相同的格式/组织结构,但是,它们各自具有不同的列长度(因为每个工作表中的数据长度根据实验持续的时间而变化)。有没有人有任何建议?

Sub Cleaning()

    Application.ScreenUpdating = False

    For Each sh In Worksheets

        sh.Activate
        'find column length for loop
        Dim collength As Integer
        collength = Cells(Rows.Count, "A").End(xlUp).Row
        'plot curves
        ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
        ActiveChart.SetSourceData Source:=Range(ActiveSheet.Name & "!$C$1:$C$" & collength, ActiveSheet.Name & "!$Q$1:$Q$" & collength)

    Next sh

    Application.ScreenUpdating = True

End Sub

在我的第二次尝试中,我试过了......仍然没有运气。

Dim strx As String
Dim stry As String
Dim rngx As Range
Dim rngy As Range

strx = "=" & ActiveSheet.Name & "!$C$2:$C$" & collength
stry = "=" & ActiveSheet.Name & "!$Q$2:$Q$" & collength

Dim Chart1 As Chart
    Set Chart1 = Charts.Add
    With Chart1
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        'Change to what your series should be called
        .SeriesCollection(1).Name = "=""Values"""
        .SeriesCollection(1).XValues = "=" & rngx
        .SeriesCollection(1).Values = "=" & rngy
    End With

在我的第三次尝试中,我录制了一个宏并对其进行了编辑以自动调整为活动工作表的列长度,但是,我在最后一行得到1004错误。

Sub plotting_test()

Application.ScreenUpdating = False
For Each sh In Worksheets
   sh.Activate
'find column length for loop
    Dim collength As Integer
    collength = Cells(Rows.Count, "A").End(xlUp).Row
   '[B3].Value = collength


    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("B1:B" & collength & ",Q1").Select
    Range("Q1").Activate
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
    ActiveChart.SetSourceData Source:=Range( _
        ActiveSheet.Name & "!$B$1:$B$" & collength & "," & ActiveSheet.Name & "!$Q$1:$Q$" & collength)


Next sh
Application.ScreenUpdating = True

End Sub

2 个答案:

答案 0 :(得分:0)

以下内容未产生任何错误,并根据您提供的数据生成了图表:

Sub mysub()
Dim sh As Worksheet

Application.ScreenUpdating = False
For Each sh In Worksheets
sh.Activate
'find column length for loop
Dim collength As Integer
collength = Cells(Rows.Count, "A").End(xlUp).Row
'[B3].Value = collength

Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Range("B1:B" & collength & ",Q1").Select
Range("Q1").Activate
Range(Selection, Selection.End(xlDown)).Select
sh.Shapes.AddChart2(240, xlXYScatter).Select
ActiveChart.SetSourceData Source:=Range( _
ActiveSheet.Name & "!$B$1:$B$" & collength & "," & ActiveSheet.Name & "!$Q$1:$Q$" & collength)

Next sh
Application.ScreenUpdating = True

End Sub

无论如何,这基本上都是你的代码,减去子名称和Dim sh As Worksheet。

由于您无论如何都要通过sh循环,因此使用它而不是Activesheet是有意义的。所以sh.Name,会给你当前的工作表名称,但总的来说,你的代码是有效的。您是否可以提供有关您可能获得的内容的更多信息,以及可能需要进一步帮助的数据样本?

答案 1 :(得分:0)

我终于明白了! 此代码进入每个工作表,清理数据并正确格式化,然后绘制所需系列的图形。

@PostConstruct
fun afterPropertiesSet() {
    System.out.println("AFTER PROPERTIES SET CALLED")
}