[已解决]vba遍历文件夹选取数据

yuan1987 · 发表于 2013-6-27 21:36

本帖最后由 yuan1987 于 2013-9-30 23:04 编辑

遍历文件夹，查找名为“基本情况表”的Excel文件，取查找到“基本情况表”中“开始”表的的A2，B2单元格数据，依次填充到归类表中统计表的A列，B列，最终结果见附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-28 09:00

Sub 汇总()
Application.ScreenUpdating = False
Dim lj As String, m, n
Dim dirname As String
Dim nm As String
Dim wb As Workbook
Dim i As Integer
On Error Resume Next
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
lj = ThisWorkbook.Path
nm = ThisWorkbook.Name
dirname = Dir(lj & "\*.xlsx")
Cells.Clear
Do While dirname <> ""
If dirname <> nm Then
Set wb = Workbooks.Open(Filename:=lj & "" & dirname, UpdateLinks:=False, ReadOnly:=True)
If Not wb Is Nothing Then
With wb
If Len(.Sheets("开始").Name) = 0 Then
Else
i = .Sheets("开始").Range("A65536").End(xlUp).Row
ThisWorkbook.Sheets("统计表").Cells(m, 1) = .Sheets("开始").Cells(2, 1).Value
ThisWorkbook.Sheets("统计表").Cells(n, 2) = .Sheets("开始").Cells(2, 1).Value
End If
.Close False
End With
Set wb = Nothing
End If
End If
dirname = Dir
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "OK"
End Sub

复制代码

跳转到最佳答案楼层

lion_zjy · 发表于 2013-6-27 22:06

呃。。。。。。路过

yuan1987 · 发表于 2013-6-27 22:48

{:1012:}

yuan1987 · 发表于 2013-6-27 22:57

Sub 汇总()
Application.ScreenUpdating = False
Dim lj As String, m, n
Dim dirname As String
Dim nm As String
Dim i As Integer
lj = ActiveWorkbook.Path
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\基本情况表.xlsx")
Cells.Clear
Do While dirname <> ""
      If dirname <> nm Then
         Workbooks.Open Filename:=lj & "\" & dirname
         i = Workbooks(dirname).Sheets("开始").Range("A65536").End(xlUp).Row
         Sheets("统计表").Activate

         Sheets("统计表").Cells(m, 1) = Workbooks(dirname).Sheets("开始").Cells(2, 1)
         Sheets("统计表").Cells(n, 2) = Workbooks(dirname).Sheets("开始").Cells(2, 1)
         Workbooks(dirname).Close False
      End If
      dirname = Dir
Loop
Application.ScreenUpdating = True
End Sub
我这样写了些，但是实现不了那个功能啊

hwc2ycy · 发表于 2013-6-28 06:46

dirname = Dir(lj & "\基本情况表.xlsx") 这里不对。
改成 dirname = Dir(lj & "\*.xlsx")
你原来的代码只会查找基本情况表.xlsx, 一轮循环后就结束了。

hwc2ycy · 发表于 2013-6-28 06:52

代码中有个问题，m,n的值从何处而来，没见你有赋值。

Sub 汇总()
Application.ScreenUpdating = False
Dim lj As String, m, n
Dim dirname As String
Dim nm As String
Dim wb As Workbook
Dim i As Integer
lj = ThisWorkbook.Path
nm = ThisWorkbook.Name
dirname = Dir(lj & "\*.xlsx")
Cells.Clear
Do While dirname <> ""
If dirname <> nm Then
Workbooks.Open Filename:=lj & "" & dirname
With ActiveWorkbook
i = .Sheets("开始").Range("A65536").End(xlUp).Row
ThisWorkbook.Sheets("统计表").Cells(m, 1) = .Sheets("开始").Cells(2, 1).Value
ThisWorkbook.Sheets("统计表").Cells(n, 2) = .Sheets("开始").Cells(2, 1).Value
.Close False
End If
End If
dirname = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

yuan1987 · 发表于 2013-6-28 08:15

本帖最后由 yuan1987 于 2013-6-28 08:22 编辑

hwc2ycy 发表于 2013-6-28 06:52
代码中有个问题，m,n的值从何处而来，没见你有赋值。

出现了这个问题啊

yuan1987 · 发表于 2013-6-28 08:21

hwc2ycy 发表于 2013-6-28 06:52
代码中有个问题，m,n的值从何处而来，没见你有赋值。

第一个end if 应该为 end with，但是改完又出现了个问题，但是运行到这一句出错
i = .Sheets("开始").Range("A65536").End(xlUp).Row，

hwc2ycy · 发表于 2013-6-28 08:32

呵呵。错了，应该是END WITH。

你得保证每个工作簿里有开始工作表嘛。

hwc2ycy · 发表于 2013-6-28 08:34

没有这个工作表，那就肯定要报错了。

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