案列:现需要按条件汇总一个文件夹下的多个Excel文件中的某列数据到汇总表格中,文件夹中的所有Excel文件都是基于一个模板,只是数据不同。
所有的Excel文件结构:
库存组织:XXX | 货主类型:XXX | 货主:XXX | ||
起始日期:2017/12/23 | 截止日期:2017/12/23 | 物料范围:全部 | ||
仓库范围:XXX | 期初单价来源:XXX | 收入发出单价来源:XXX | K列 | L列 |
物料编码 | 物料名称 | 仓库名称 | 数量 | 库存 |
1.起始日期 = 截止日期,取K列值;
2.起始日期 != 截止日期,取L列值;
Sub Collect()
Dim myPath, myFile, wk As Workbook, ws As Worksheet, ThisWs As Worksheet
Dim ThisRowCount As Integer
Dim AnotherRowCount As Integer
Dim OutputColumn As Integer '输出数据所在的列;
Dim test1, test2, test3, test4 'test fields;
Dim StartDate As Date
Dim EndDate As Date
Application.ScreenUpdating = False '程序运行期间不刷新屏幕
myPath = "D:\all\" '在这里输入你文件夹的路径,即你存放需要处理文件的文件夹;最后的“\”请一定加上!
myFile = Dir(myPath & "*.xls") 'Dir(".xls")依次找寻指定路径中的.xls文件,如果是.xlsx的文件请改为.xlsx;“*”为通配符。
Set ThisWs = ThisWorkbook.Worksheets(2) '当前工作簿,all的第二个worksheet;
ThisRowCount = ThisWs.UsedRange.Rows.Count '工作表all中使用了的行数;
OutputColumn = 5 '被写入的工作表all是从第六列开始写入,即F列,Do While循环中首先对其进行了+1,以确保从第六列开始;
Do While myFile <> "" '当指定路径中不为空时进行循环
If myFile <> ThisWorkbook.Name Then '取出的文件不是本文件“all.xls”
Set wk = Application.Workbooks.Open(myPath & myFile) '打开符合要求的文件
Set ws = wk.Worksheets(1)
AnotherRowCount = ws.UsedRange.Rows.Count '依次取出的每个工作表的总行数;
'StartDate = Right(ws.Cells(2, 1), 9) '截取开始日期,从右向左截取,固定了取9位,但存在10位的情况,所以这里不适用该方法;改为使用Mid函数。
'EndDate = Right(ws.Cells(2, 2), 9) '截取截止日期,从右向左截取,固定了取9位,但存在10位的情况,所以这里不适用该方法;改为使用Mid函数。
StartDate = Mid(ws.Cells(2, 1), (InStr(ws.Cells(2, 1), ":") + 1), Len(ws.Cells(2, 1)) - InStr(ws.Cells(2, 1), ":"))
EndDate = Mid(ws.Cells(2, 2), (InStr(ws.Cells(2, 2), ":") + 1), Len(ws.Cells(2, 2)) - InStr(ws.Cells(2, 2), ":"))
If StartDate = EndDate Then '如果开始日期和截止日期相同,取K列的值;
OutputColumn = OutputColumn + 1
ThisWs.Cells(1, OutputColumn) = StartDate
For i = 2 To ThisRowCount Step 1 '写入的worksheet第一行为行名称,这里从第二行开始;
For j = 5 To AnotherRowCount Step 1 '销量文件前四行为其他信息,这里从第五行开始;
If ThisWs.Cells(i, 1) = ws.Cells(j, 1) Then '物料编码是否相等;
'test1 = ws.Cells(j, 1)
'test2 = ThisWs.Cells(i, 1)
ThisWs.Cells(i, OutputColumn) = ws.Cells(j, 11) '将K列的值取到该工作表的OutputColumn列;
'test3 = ThisWs.Cells(i, 6)
'test4 = ws.Cells(j, 11)
End If
Next j
Next i
'如果开始日期和截止日期不在同一天,即月底,这时需要判断;DateAdd()函数,日期的加减计算。
ElseIf StartDate <> EndDate And (StartDate = DateAdd("d", 1, EndDate) Or EndDate = DateAdd("d", 1, StartDate)) Then
OutputColumn = OutputColumn + 1
ThisWs.Cells(1, OutputColumn) = StartDate
ThisWs.Cells(1, (OutputColumn + 1)) = EndDate '月底均值,写两次值到目标数据表中;
For i = 2 To ThisRowCount Step 1 '写入的worksheet第一行为行名称,这里从第二行开始;
For j = 5 To AnotherRowCount Step 1 '销量文件前四行为其他信息,这里从第五行开始;
If ThisWs.Cells(i, 1) = ws.Cells(j, 1) Then '物料编码是否相等;
ThisWs.Cells(i, OutputColumn) = ws.Cells(j, 12) '将L列的值取到该工作表的OutputColumn列;
ThisWs.Cells(i, (OutputColumn + 1)) = ws.Cells(j, 12) '将L列的值取到该工作表的OutputColumn+1列;
End If
Next j
Next i
OutputColumn = OutputColumn + 1
End If
wk.Close '关闭文件
End If
myFile = Dir '找寻下一个*.xlsx文件
Loop
Application.ScreenUpdating = True '前面被更改为FALSE,此类语句一般成对使用
End Sub