|
在原代码上改的。
Public Sub hebing()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook '定义工作簿变量
Dim sht As Worksheet '定义工作表变量
mypath = ThisWorkbook.Path & "\" '获取当前程序运行的目录
TMPNAME = Dir(mypath & "*.xlsx") '获取工作簿名称
Set D = CreateObject("scripting.dictionary")
R = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row '获取当前工作表的最大行号
ARR = Sheet1.Range("B2:B" & R)
For I = 1 To UBound(ARR)
D(ARR(I, 1)) = ""
Next
Do While TMPNAME <> "" '循环判断 工作簿名称不为空,就进行提取数据
If Not D.EXISTS(Left(TMPNAME, 10)) Then
If TMPNAME <> ThisWorkbook.Name Then '判断工作簿名称不等于当前程序工作簿名称
Set wb = Workbooks.Open(mypath & TMPNAME, 0, 1) '打开工作簿,赋值给变量 wb
Set sht = wb.Sheets(1) ' 赋值打开工作簿的第一个工作表给变量 sht
R = sht.Cells(Rows.Count, "b").End(xlUp).Row '获取打开的工作簿,最大行号
sjrr = sht.Range("a1:e" & R) '获取已打开工作簿的数据到 数组 sjrr
jifang = Mid(TMPNAME, 1, 10) '打开工作表的 a1 单元格值 机房位置 jifang
rq = Mid(jifang, 1, 4) & "/" & Mid(jifang, 5, 2) & "/" & Mid(jifang, 7, 2) '根据a1 单元格的值 生成日期
For I = 1 To UBound(sjrr) '表中的数据
If sjrr(I, 1) <> "" Then '判断a列的 值不为空,就把a列的值 也就是机房编号给变量 jfbh
jfbh = sjrr(I, 1)
End If
If sjrr(I, 2) <> "" Then '判断第二列值不为空 就开始累加输出信息到工作表
mr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1 '获取汇总工作表的最后行号 给变量mr
With Sheet1
.Cells(mr, "a") = rq '输出日期
.Cells(mr, "b") = jifang '机房巡检次数
.Cells(mr, "c") = jfbh '机房编号
.Cells(mr, "d") = sjrr(I, 2) '机柜位置
.Cells(mr, "e") = getwd(sjrr(I, 3)) '左边温度 getwd 是一个自定义函数 传入原始数据,自动清除温度符号和获取最大值
.Cells(mr, "f") = getwd(sjrr(I, 4)) '中间温度
.Cells(mr, "g") = getwd(sjrr(I, 5)) '右边温度
If .Cells(mr, "e") <> 0 Or .Cells(mr, "f") <> 0 Or .Cells(mr, "g") <> 0 Then
.Cells(mr, "H") = Application.Average(.Cells(mr, "e"), .Cells(mr, "f"), .Cells(mr, "g"))
End If
End With
End If
VBA.DoEvents '释放系统控制权,防止程序假死
Next
wb.Close '关闭已打开的工作簿
End If
End If
TMPNAME = Dir() '获取下一个文件的工作簿名称
Loop
MsgBox "ok" '处理完成,消息提示框
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub |
|