VBA在循环期间在数组中存储多个列,然后返回值

时间:2016-12-19 16:47:06

标签: arrays excel vba excel-vba

我有一个宏,它将用户定义的函数(代码中的R.ajseasonX13)应用于工作表“NSA”中的多个列,然后返回工作表“SA”中的值。

问题是我的代码一次只将一个函数应用于列。一旦VBA继续从标签“NSA”到“SA”来回走动,这就变得非常慢。

我知道如何创建一个范围,其中包含需要使用函数“R.ajseasonX13”修改的所有列。我的疑问是:如何应用其中一列的函数,在代码运行时将所有列存储在矩阵中,然后仅返回带调整值的最终矩阵?

我曾尝试创建一个数组,但我仍然坚持如何使用数字数据识别第一行以及如何在For循环中添加新列。

这是我的代码:

Sub Dessaz()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook

Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")

Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")

Dim col As Range
Dim nsaArray As Variant

'Finds the row of the first cell with numeric data in column A (where dates are stored)
wsNSA.Range(Cells(1, 1), Cells(1048576, 1)).NumberFormat = "General"
datas_col = wsNSA.Range(Cells(1, 1), Cells(10000, 1))
data1_linha = Application.Match(True, Application.Index(Application.IsNumber(datas_col), 0), 0)
wsNSA.Range(Cells(1, 1), Cells(1048576, 1)).NumberFormat = "dd/mm/yyyy"

'Determinates one of the parameters of the user defined function "R.ajseasonX13" used ahead
inicio = wsNSA.Cells(data1_linha, 1).Value
inicio = Year(inicio) & "-" & Month(inicio) & "-" & "01"

'LR is the last column with data and LC is the last column with data
LR = wsNSA.Cells(data1_linha, 1).End(xlDown).Row
LC = wsNSA.Cells(LR, 1).End(xlToRight).Column

'States another one of the parameters of the user defined function
p = 12

nsaArray = wsNSA.Range(wsNSA.Cells(1, 2), wsNSA.Cells(LR, LC))
For Each col In wsNSA.Range(wsNSA.Cells(1, 2), wsNSA.Cells(LR, LC))
  wsNSA.Activate
  nsa = wsNSA.Range(wsNSA.Cells(1, col.Column), wsNSA.Cells(LR, col.Column))

'Finds the first row with numeric data in each column of the data series
  num_linha = Application.Match(True, Application.Index(Application.IsNumber(nsa), 0), 0)
  nsaArray = wsNSA.Range(wsNSA.Cells(num_linha, col.Column), wsNSA.Cells(LR, col.Column))

'Applies the user defined function to the "nsa" columns and returns their value (but only one at a time, which is
'not as fast as possivle in VBA
'wsSA.Activate
  sa = Application.Run("R.ajseasonX13", nsa, inicio, p)
  wsSA.Range(wsSA.Cells(num_linha, col.Column), wsSA.Cells(LR, col.Column)) = sa
Next

End Sub

0 个答案:

没有答案