vba - Do While 循环不循环通过文件夹
问题描述
我在一个文件夹中有大约 1000 个文件,我想单独循环,处理数据,然后复制/粘贴到单独的 *.xlsx 工作簿中。“处理”数据的代码似乎存在问题,因为当我尝试返回 Do-While-Loop 时,它不会打开下一个文件。如果我不运行附加代码,它将遍历所有文件
Sub LoopThroughSingle_TXT_Files()
Dim currentPath As String
Dim currentFile As String
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Folder2\cd1.xlsx"
Dim cd1 As Workbook
Set cd1 = Workbooks("cd1")
currentPath = "D:\Folder1\Data\"
currentFile = Dir(currentPath & "*.txt")
Do While currentFile <> ""
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Folder1\Data\wb1.xlsx"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & currentPath & currentFile, Destination:=Range("$A$1"))
.NAME = "Data"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Module3.z_CleanData
Module3.zz_paste_in_combined()
currentFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub z_Clean_Data()
Range("M2").Activate: ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
Range("N2").Activate: ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
Range("O2").Activate: ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
Range("P2").Activate: ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
Range("Q2").Activate: ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""",R[-1]C[-11],RC[-11])"
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("M2:Q" & lastRow).Activate: Selection.FillDown: Selection.Copy
Range("B2").Activate: Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False: Application.CutCopyMode = False
Range("M:Q").Delete
Application.Goto Reference:="R1C1:R500C6": Selection.Copy
End Sub
Sub zz_paste_in_combined()
Dim wb1 As Window
For Each wb1 In Application.Windows
If wb1.Caption Like "wb1*.xlsx" Then
wb1.Activate
Exit For
End If
Next
Dim cd1 As Window
For Each cd1 In Application.Windows
If cd1.Caption Like "cd1*.xlsx" Then
cd1.Activate
Exit For
End If
Next
cd1.Activate
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False:
Application.CutCopyMode = False
wb1.Activate
ActiveWorkbook.Close SaveChanges:=False
'###Clear files from combined_data if it exists
Dim myFilePath2Delete As String: myFilePath2Delete = "D:\Kibot\Data\!Daily Data (saved as EOD)\Volume-Price Screen\zNuLong_Analysis_Individual\.xlsx"
If Dir(myFilePath2Delete) <> "" Then
Kill myFilePath2Delete
End If
End Sub
我尝试了很多不同的方法来找出解决方案,但无法让它按照我想要的方式工作。我真的不确定如何处理数据,将其粘贴到不同的工作簿中,然后继续执行 Do-While-Loop 而不会意外结束。
提前感谢您的任何意见。
史蒂文
解决方案
我会这样工作:
Sub mymacro()
Dim objFile As Scripting.File
Dim objFolder As Scripting.Folder
Dim mywb as string
Set objFolder = CreateObject("Shell.Application").Namespace(objFolder.Path)
'Loop through each file in the folder
For Each objFile In objFolder.Files
objFile.Open (objFile.Path)
mywb = objFile.Name
Workbooks.Add
‘Your code here
Next objFile
End sub
希望这可以帮助!!
推荐阅读
- python - 在文件中的逗号前插入一个值
- java - 自定义类视图中的实时数据
- laravel - 在 laravel 中调用 null 上的成员函数 update()
- c# - 请求 Cookie 为 0,即使在 requestheader 中发送
- azure - Azure Key Vault 不允许通过专用终结点连接进行访问
- google-bigquery - BigQuery 获取查询数据
- algorithm - 使用扫除法和分治法的面积最大查询
- python - 如何在 python 中创建 JWKS 公钥/私钥对?
- python - Pytest 最小工作示例:收集测试但找不到模块。配置测试集合的最佳方式是什么?
- python - 使用 matplotlib 绘制具有特定距离的框