[已解决]请教如何汇总文件夹下所有工作簿的名称以及第一个表格的某个单元格数值

541181001 · 发表于 2014-5-12 14:34

请问汇总文件夹下所有工作簿的名称以及第一个表格的某个单元格数值代码怎么写

最佳答案

hwc2ycy

2014-5-12 15:07

Sub demo()
Dim strPath As String, strFile As String
Dim arr(1 To 1000, 1 To 3)
Dim i As Long
strPath = ThisWorkbook.Path & Application.PathSeparator & "源文件" & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
With GetObject(strPath & strFile)
Windows(.Name).Visible = True
i = i + 1
arr(i, 1) = Left(strFile, InStrRev(strFile, ".") - 1)
With .Worksheets(1)
arr(i, 2) = .Range("e2").Value
arr(i, 3) = .Range("f2").Value
End With
.Close False
End With
End If
strFile = Dir
Loop
If i > 0 Then
With Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(i, 3).Value = arr
End With
MsgBox "汇总完成"
Else
MsgBox "当前数据目录下无文件可汇总"
End If
Application.ScreenUpdating = True
End Sub

复制代码

hwc2ycy · 发表于 2014-5-12 15:03

Sub demo()
Dim strPath As String, strFile As String
Dim arr(1 To 1000, 1 To 3)
Dim i As Long
strPath = ThisWorkbook.Path & Application.PathSeparator & "源文件" & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
With GetObject(strPath & strFile)
Windows(.Name).Visible = True
i = i + 1
arr(i, 1) = Left(strFile, InStrRev(strFile, ".") - 1)
With .Worksheets(1)
arr(i, 2) = .Range("e2").Value
arr(i, 3) = .Range("f2").Value
End With
.Close False
End With
End If
strFile = Dir
Loop
With Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(i, 3).Value = arr
End With
Application.ScreenUpdating = True
MsgBox "ok"
End Sub

复制代码

hwc2ycy · 发表于 2014-5-12 15:06

后面忘了加判断了，避免找不到文件的情况。

hwc2ycy · 发表于 2014-5-12 15:07

Sub demo()
Dim strPath As String, strFile As String
Dim arr(1 To 1000, 1 To 3)
Dim i As Long
strPath = ThisWorkbook.Path & Application.PathSeparator & "源文件" & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
With GetObject(strPath & strFile)
Windows(.Name).Visible = True
i = i + 1
arr(i, 1) = Left(strFile, InStrRev(strFile, ".") - 1)
With .Worksheets(1)
arr(i, 2) = .Range("e2").Value
arr(i, 3) = .Range("f2").Value
End With
.Close False
End With
End If
strFile = Dir
Loop
If i > 0 Then
With Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Resize(i, 3).Value = arr
End With
MsgBox "汇总完成"
Else
MsgBox "当前数据目录下无文件可汇总"
End If
Application.ScreenUpdating = True
End Sub

复制代码

hwc2ycy · 发表于 2014-5-12 15:08

汇总.rar (17.53 KB, 下载次数: 4)

541181001 · 发表于 2014-5-12 16:49

hwc2ycy 发表于 2014-5-12 15:08

如果E2 F2单元格是个公式汇总过来的是个#REF!，怎样修改那个代码？

		自动登录	找回密码
密码			注册