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循环遍历每一列，直到Date（第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

想出来。感谢Cool Blue的建议。

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

VBA：在多维数组中添加值

1 个答案: