VBA：在多维数组中添加值

Question

我很困惑，我会尽力解释这一点。我使用一张纸作为数据库，另一张用于生成报告。当用户输入开始日期 (20130801) 和结束日期 (20130808) 时，报告工作簿将调用数据库工作簿。数据库工作簿的“A”列用于标记，设置如下：

Date  
Dept1  
060000  
...... 'Every 15 min from 6am to 7pm (53 15min time intervals)  
190000   
Dept2  
060000  
...... 'Every 15 min from 6am to 7pm (53 15min time intervals)  
190000  
Dept3 ... 'For a total of 5 dept.  

我可以使用 .Find 根据用户请求的开始日期查找第一列，然后使用 Do While 循环遍历每一列，直到日期（第 1 行，第 1 列？）= 结束日期，但我需要帮助找到一种将每列下的数据添加到数组中的方法，然后在循环执行 Do While 循环时保留并将其他数据添加到数组中。完成 Do While 循环后，我将获取总值并将它们粘贴到报告中。这是一个例子：

Date.....20130801...20130802...And So On   
Dept1...."Blank"...."Blank"...  
060000...5..........1.........    
061500...6..........2.........      
063000...7..........3.........  

...

以 Dept1(060000) 为例，我需要数组在此时添加每一天的每个值，直到到达结束日期。稍后我需要提取该总和，除以天数，然后将该值添加到报告的单元格中。任何帮助将不胜感激。

Answer 1

想通了。感谢酷蓝的建议。

Sub WorkArrivalHistoryGraph()
'
' WorkArrivalHistoryGraphRetrDataWIPS
'

Dim colBegin As Variant
Dim colEnd As Variant
Dim r As Variant
Dim x As Variant
Dim index As Integer
Dim BeginDate As Variant
Dim EndDate As Variant
Dim ColCount As Integer
Dim wsReport As Worksheet
Dim wsData As Worksheet
Dim wkbkReport As Workbook
Dim wkbkData As Workbook
Dim FindColumn1 As Range
Dim FindColumn2 As Range

Dim ar1(52) As Double
Dim ar2(52) As Variant
Dim ar3(52) As Variant
Dim ar4(52) As Variant
Dim ar5(52) As Variant
Dim ar6(52) As Variant

Set wkbkReport = Workbooks("?.xlsm")
Set wkbkData = Workbooks("?.xlsm")

Set wsReport = wkbkReport.Worksheets("WAHistory")
Set wsData = wkbkData.Worksheets("WorkArrival")

BeginDate = wsReport.Range("B1").Value
EndDate = wsReport.Range("B2").Value

With wkbkData.Sheets("WorkArrival")
Set FindColumn1 = wsData.UsedRange.Find(What:=BeginDate, LookIn:=xlValues)
End With

colBegin = FindColumn1.Column 'this is the first column where you want to check for data

With wkbkData.Sheets("WorkArrival")
Set FindColumn2 = wsData.UsedRange.Find(What:=EndDate, LookIn:=xlValues)
End With

colEnd = FindColumn2.Column 

x = colBegin
ColCount = 0

Do While (wsData.Cells(1, x).Value >= BeginDate And wsData.Cells(1, x).Value <= EndDate)
'This will loop until row 1 is empty
x = x + 1
ColCount = ColCount + 1
Loop

wkbkData.Activate
Sheets("WorkArrival").Select

'Retrieve Data
index = 0
For r = 3 To 55
ar1(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

index = 0
For r = 57 To 109
ar2(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

index = 0
For r = 111 To 163
ar3(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

index = 0
For r = 165 To 217
ar4(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

index = 0
For r = 219 To 271
ar5(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

index = 0
For r = 273 To 325
ar6(index) = WorksheetFunction.Sum(wsData.Range(Cells(r, colBegin), Cells(r, colEnd)))
index = index + 1
Next

'Update Report
wkbkReport.Activate
Sheets("WAHistory").Select

index = 0
For r = 4 To 56
    Range("C" & r) = ar1(index)
    Range("D" & r) = ar2(index)
    Range("E" & r) = ar3(index)
    Range("F" & r) = ar4(index)
    Range("G" & r) = ar5(index)
    Range("H" & r) = ar6(index)
    index = index + 1
Next

End Sub