一、在myModule里：dataCombine过程，参数为6位年月字符串，循环明细清单文件所有工作表，把符合条件的工作簿里的工作表进行汇总。Sub dataCombine(strMonth As String) Application.ScreenUpdating = False Dim FSO As Object, folder As Object, file As Object Dim arr(), arrtemp() Dim dataFolder As String, dataFile As String Dim ws As Worksheet, wb As Workbook Dim lastRow As Long, lastCol As Long Dim currMonth As String, fileExtn As String '//指定目标文件夹 dataFolder = ThisWorkbook.Path & "\故障清单" Set FSO = CreateObject("Scripting.FileSystemObject") '//通过FSO取得文件夹对象 Set folder = FSO.getfolder(dataFolder) Set ws = ThisWorkbook.Sheets("工单列表") '//把工单列表表头字段装入数组，并清空第2行及以下内容 With ws lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Clear arr = .Range(.Cells(1, 1), .Cells(1, lastCol)) arr = Application.WorksheetFunction.Transpose(arr) r = UBound(arr) End With '//遍历folder中的所有文件 For Each file In folder.Files fileExtn = Mid(file.Name, InStrRev(file.Name, ".")) '//只处理Excel文件，避开临时文件 If fileExtn Like ".xl*" And InStr(file.Name, "~$") = 0 Then If InStr(file.Name, strMonth) Then '//如果文件名包括条件日期 dataFile = file.Path & "\" & file.Name Set wb = Workbooks.Open(file.Path) For Each ws In wb.Sheets '//循环所有工作表，虽然本案例只有一个 If ws.UsedRange.Count > 1 Then '//判断工作表是否有数据 arrtemp = ws.UsedRange k = UBound(arr, 2) '//动态扩展数组 ReDim Preserve arr(1 To r, 1 To UBound(arrtemp) + k - 1) '//循环两个数组，比较第一列（行）表头字段，相同的把数据写入arr For i = 1 To UBound(arr) For j = 1 To UBound(arrtemp, 2) If arrtemp(1, j) = arr(i, 1) Then For h = k + 1 To UBound(arr, 2) arr(i, h) = arrtemp(h - k + 1, j) Next End If Next Next End If Next wb.Close End If End If Next '//把数据写入目标工作表 Set ws = ThisWorkbook.Sheets("工单列表") ws.Cells(1, 1).Resize(UBound(arr, 2), UBound(arr)) = Application.WorksheetFunction.Transpose(arr) ws.Activate Application.ScreenUpdating = TrueEnd Sub二、在工作表“汇总”里，工作表Change事件，如果是G1单元格、输入4位以上数字，则调用SetDataValidation过程，如果长度是6位，则调用dataCombine过程，这里没有限定为数字，如果G1的值不包括在清单文件名中，则无数据可合并。Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$G$1" Then If Len(Target) >= 4 And IsNumeric(Target) Then Call SetDataValidation(Target) End If If Len(Target) = 6 Then Call dataCombine(CStr(Target.Value)) End If End IfEnd Sub 三、在工作表“汇总”里，SetDataValidation过程，根据单元格输入的值来设置数据验证，更改下拉列表的年份。Private Sub SetDataValidation(rng As Range) Dim wsSource As Worksheet Dim rngStr As String Dim listStr As String '//取G1单元格输入值的前4位，如果输入正确应该是年份，再与1-12进行组合 For i = 1 To 12 listStr = listStr & Left(rng.Value, 4) & Format(i, "00") & "," Next '//去掉结尾的 "," listStr = Left(listStr, Len(listStr) - 1) '//删除已有的数据验证 rng.Validation.Delete With rng.Validation '//添加数据验证，源为listStr .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=listStr .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = False '//不显示出错警告，改为TRUE则显示，同时不能输入不合验证的字符 End WithEnd Sub 四、在工作表“汇总”里，命令按钮点击事件，调用dataCombine过程。Private Sub CmdCombine_Click() Call dataCombine(CStr(Range("G1").Value))End Sub
|
