excel - 统计各种工作簿和工作表中的数据并将其粘贴到一个工作簿中
问题描述
我想计算字母“T”出现在各种工作簿(每个工作簿大约 11 张)的清单中的次数,并将最终数据粘贴到一个工作簿中。
我有这个代码,但我不断得到
“错误代码 9”
我很确定我已经定义了正确的工作簿。还有其他方法可以完成我的最终结果吗?提前致谢
Private Sub CommandButton3_Click()
Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim x As Integer
Dim wash_count As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
For Each ws In wb.Sheets
If ws.Name <> "Summary" Then
For x = 5 To 74
If ws.Cells(x, 2).Value = "Wash" And (ws.Cells(x, 4).Value = "T") Then
wash_count = wash_count + 1
End If
Next x
End If
Next ws
wb1 = Workbooks("Book3.xlsx")
wb1.Activate
wb.Sheets("Summary").Range("D6") = wash_count
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
解决方案
我会尽力帮助 :) 我相信问题的根本原因是您使用了 'wb1 =...' 而不是 'set wb1 =..'。我对代码进行了一些额外的编辑和注释,它似乎对我来说效果很好。我很好奇它是否也会为您解决问题。
Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim x As Integer
Dim wash_count As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
For Each ws In wb.Sheets
If ws.Name <> "Summary" Then
For x = 5 To 74
If StrConv(ws.Cells(x, 2).Value, vbProperCase) = "Wash" And StrConv(ws.Cells(x, 4).Value, vbProperCase) = "T" Then 'added the StrConv to make sure you don't loose a case just because it was written in capital or lowercase letters
wash_count = wash_count + 1
End If
Next x
End If
Next ws
Set wb1 = Workbooks("Book3.xlsx") 'wb1 = Workbooks("Book3.xlsx")
'changed your code 'wb1 = Workbooks("Book3")' to set 'wb1 =...' as workbook variables need to be assigned with 'set' command
'you might want to add some handling of whether the workbook 'Book3' is already opened and if not then to open it
'this seem strange to me, I thought you wanted to count the 'T's in all of the workbooks
'in the folder and then paste the final number to one place
'which I thought was going to be wb1 'Book3'
'if that was the case then the line 'wb.Sheets("Summary").Range("D6") = wash_count' should be
'-> 'wb1.Sheets("Summary").Range("D6") = wash_count'
'also I'd move the whole line after the loop and paste only the final wash_count in the very end
wb.Sheets("Summary").Range("D6") = wash_count
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
推荐阅读
- laravel - Laravel Jobs:假设索引“job”导致错误
- android - 如何从 WindowManager 获取“视图”
- c++ - 使用 libharu 将 PNG 图像从文件加载到内存缓冲区
- javascript - axios 不返回承诺,不同步
- mongodb - 删除有条件的聚合
- laravel - Laravel - HTML 渲染在错误的地方
- c++ - 你如何声明/使“QBarSet”成为一个数组?
- list - 内部版本号列表 - 方案
- wordpress - PHP 7.3 函数 create_function() 已弃用
- c# - 有什么方法可以使用 C# 从文件中获取数字签名?