excel - Excel vba使用字典循环提取数据
问题描述
下面的代码能够在文件夹中循环我的文件并将文件名添加到字典中,但是当我添加我的提取代码时,它应该将文件夹中每个文件的数据提取到一个 Excel 表和文件 1应该在 A2:M2 范围内,文件 2 在 A3:M3 范围内,依此类推。但是尽管能够从每个文件中提取数据,但每次第一个文件将被写入范围 A2:M2 但随着它继续到下一个文件,它会将第一个文件中的数据覆盖到同一范围 A2:M2 即使文件 2数据应写入 A3:M3,文件 3 写入 A4:M4,依此类推。
我可以知道如何解决这个问题,非常感谢。
Public Dict As Object
Sub EEE()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Dim oFSO As Object, oFolder As Object, ofile As Object
Set oFSO = CreateObject("Scripting.fileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Users\Desktop\")
If Dict Is Nothing Then
Set Dict = CreateObject("Scripting.Dictionary")
Dict.Add Key:="filename", Item:=ofile
End If
For Each ofile In oFolder.Files
If Not Dict.Exists(oFSO.GetBaseName(ofile)) Then
' start of extraction code
Dim a As Range
Dim wkbData As Workbook
Set wkbData = Workbooks.Open(ofile.path)
Dim wksData As Worksheet
ActiveSheet.Name = "Book1"
Set wksData = wkbData.Worksheets("Book1") ' -> Assume this file has only 1 worksheet
Dim LastRow As Long
LastRow = wks.Range("A" & wks.Rows.count).End(xlUp).row + 1
wks.Cells(LastRow, 6).value = ofile.Name
Set a = wksData.Columns("A:A").Find(" test1234 : ", LookIn:=xlValues)
If Not a Is Nothing Then
wks.Cells(LastRow, 1) = Split(a.value, ":")(1)
End If
wkbData.Close False
' end of extraction code
Range("A:M").EntireColumn.AutoFit
Range("A1").AutoFilter
Debug.Print "A: " & oFSO.GetBaseName(ofile)
Dict.Add oFSO.GetBaseName(ofile), 1
Else
'skip
Debug.Print "E: " & oFSO.GetBaseName(ofile)
End If
Next ofile
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
End Sub
解决方案
根据我上面的评论:
Dim LastRow As Long
LastRow = wks.Range("A" & wks.Rows.count).End(xlUp).row + 1 '<< this can be outside your loop
For Each ofile In oFolder.Files
If Not Dict.Exists(oFSO.GetBaseName(ofile)) Then
Dim a As Range
Dim wkbData As Workbook
Set wkbData = Workbooks.Open(ofile.path)
Dim wksData As Worksheet
Set wksData = wkbData.Worksheets(1) ' -> Assume this file has only 1 worksheet
wks.Cells(LastRow, 6).value = ofile.Name
Set a = wksData.Columns("A:A").Find(" test1234 : ", LookIn:=xlValues)
If Not a Is Nothing Then
wks.Cells(LastRow, 1) = Split(a.value, ":")(1)
Else
wks.Cells(LastRow, 1) = "No Data!"
End If
wkbData.Close False
Debug.Print "A: " & oFSO.GetBaseName(ofile)
Dict.Add oFSO.GetBaseName(ofile), 1
LastRow = LastRow +1 '<< increment the row
Else
Debug.Print "E: " & oFSO.GetBaseName(ofile)
End If
Next ofile
推荐阅读
- python - 只有循环中的第一个 subprocess.Popen(..., stdin=f) 才能正常工作
- python - Python尴尬的bash字符串导出Bug
- verilog - 主模块内的模块实例化
- r - Bookown' 参考书目多种语言
- meteor - 降级 Meteor 版本
- idris - 如何在没有回声的情况下读取字符
- android - 从可以包含在其他 Android 应用程序中的现有 Android 应用程序 (APK) 创建 SDK(或库)
- r - 如何从R中的列表中找到最接近的匹配项
- r - r中多列条件的平均值
- html - 将 html 输入导出到 excel/csv