数组和代替很多代码

时间:2012-09-19 12:50:02

标签: excel excel-vba excel-2010 vba

现在我已经创建了一个宏来创建两个从不同工作表中获取值的图表。 我想现在代码太多了。我想以某种方式减少它。

继承我的代码

Sub AddChart(namn As String, UxV As String, UyV As String, AxV As String, AyV As String, ExV As     String, EyV As String, CA As Integer)

With ThisWorkbook.Worksheets("Chart").ChartObjects.Add(200, 200, 600, 400).Chart
    .Parent.Name = namn

    If Not .HasTitle Then
        .HasTitle = True
        .ChartTitle.Text = namn
    End If

    .ChartType = xlXYScatterSmoothNoMarkers
    .Axes(xlValue).CrossesAt = CA
    .Axes(xlCategory).TickLabels.NumberFormat = "YYYY-MM-DD"

    With .SeriesCollection.NewSeries
        .Name = "Us"
        .XValues = UxV
        .Values = UyV
    End With

    With .SeriesCollection.NewSeries
        .Name = "Ai"
        .XValues = AxV
        .Values = AyV
    End With

    With .SeriesCollection.NewSeries
         .Name = "Eu"
         .XValues = ExV
         .Values = EyV
    End With
End With
End Sub
--------------------

Sub calsub()


Dim n As String
Dim CA As Integer
Dim UxT As String
Dim UyT As String
Dim AxT As String
Dim AyT As String
Dim ExT As String
Dim EyT As String

Dim n2 As String
Dim CA2 As Integer
Dim UxP As String
Dim UyP As String
Dim AxP As String
Dim AyP As String
Dim ExP As String
Dim EyP As String

n = "Temperature"
SxT = "=US!A2:A372"
SyT = "=US!C2:C370"
NxT = "=AI!A2:A472"
NyT = "=AI!C2:C472"
FxT = "=EU!A2:A572"
FyT = "=EU!C2:C572"
CA = -20

n2 = "Precipitation"
SxP = "=US!A2:A372"
SyP = "=US!D2:D372"
NxP = "=AI!A2:A371"
NyP = "=AI!D2:D371"
FxP = ""
FyP = ""
CA = -100

Call AddChart(n, UxT, UyT, AxT, AyT, ExT, EyT, CA)
Call AddChart(n2, UxP, UyP, AxP, AyP, ExP, EyP, CA)

End Sub

我正想着以某种方式创建它

Sub AddChart(namn As String, xV() As String, yV() As String, CA As Integer) <------

With ThisWorkbook.Worksheets("Chart").ChartObjects.Add(200, 200, 600, 400).Chart
    .Parent.Name = namn

    If Not .HasTitle Then
        .HasTitle = True
        .ChartTitle.Text = namn
    End If

    .ChartType = xlXYScatterSmoothNoMarkers
    .Axes(xlValue).CrossesAt = CA
    .Axes(xlCategory).TickLabels.NumberFormat = "YYYY-MM-DD"

for -----------> 

    With .SeriesCollection.NewSeries
        .Name = "Us"
        .XValues = UxV
        .Values = UyV
    End With

next <-----------

End With
End Sub

1 个答案:

答案 0 :(得分:1)

好吧,如果你的范围保持不变,你可以使用像

这样的东西
For each wks in activeworkbook.worksheets 

或组成一系列相关工作表进行循环。

然后你会

.Name = wksArray(i).name.Name = wks.name代替`.Name =&#34;我们&#34;&#39;

你的数组也可以是多维的,所以你可以编写类似的代码:

    .Name = array(i,1).name
    .XValues = array(i,2)
    .Values = array(i,3)