Question

我正在编写一个代码，用于将工作簿（fromWB）名称（tempName）的前几个字符与工作表的名称（sheetName）进行比较。如果它们匹配，则将文件中的数据复制到工作表（ws）中。我试图让我的代码遍历文件文件夹并通过工作簿（fromWB）迭代多个工作表但代码卡在do while循环中（迭代工作表），我就是这样不知道如何解决它。它会停止复制并粘贴到工作表中，因为tempName没有更改，因为代码没有循环遍历文件夹。我调试了代码，我没有收到任何错误。任何帮助将不胜感激!!

编辑：两个嵌套的For Each循环是否有效？

Sub Import(Optional sPath As Variant)
Dim SelectFolder As FileDialog
Dim fromWB As Workbook
Dim toWB As Workbook
Dim ws As Worksheet
Dim fileName As String
Dim sheetName As String
Dim tempName As String


'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
'Application.EnableEvents = False

'Retrieve Target Folder Path From User
Set SelectFolder = Application.FileDialog(msoFileDialogFolderPicker)

With SelectFolder
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    sPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
sPath = sPath
If sPath = "" Then GoTo ResetSettings

sFile = Dir(sPath & "*xlsx")
Workbooks("Temp.xlsx").Activate
Set toWB = ActiveWorkbook

Do While sFile <> ""
    Set fromWB = Workbooks.Open(sPath & sFile)
    tempName = Left(sFile, 3)
    Range("A1:B10").Select
    Selection.Copy

    For Each ws In toWB.Worksheets
        Windows("Temp.xlsx").Activate
        sheetName = ActiveSheet.Name
        If sheetName = tempName Then
            ws.Activate
            Range("A4").PasteSpecial xlPasteAllUsingSourceTheme
        End If
        ws.Activate
    Next ws
sFile = Dir()
Loop


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Answer 1

我不认为你的每个循环都有问题。在我看来，它会陷入do while循环中。

您不会在循环中的任何位置更改sFile，因此它永远不会中断。

Do While sFile <> ""

Loop

编辑：

Sub LoopThroughFiles()
    Dim MyObj As Object, MySource As Object, file As Variant
    file = Dir("c:\testfolder\")
    While (file <> "")
      'code here
      file = Dir
    Wend
End Sub

来自：Loop through files in a folder using VBA?

VBA陷入嵌套循环中

1 个答案: