Question

下午好，

我有一个运行多个宏的工作表。

模块＃1在第3行的列中列出主目录的子文件夹。（正确工作）

模块＃2根据关键字从模块＃1的结果文件夹中列出一个特定的子文件夹，结果打印到第4行。该模块对于A列正常运行，尽管我在重复计算时没有做到这一点。基于行3的相关单元格引用的列。代码正在做的是将正确的结果返回到A4，然后将相同的结果打印到B4，C4 ...我似乎无法修改此代码以考虑第3行结果对于每一列。

Private Sub PrintFolders()
Dim objFSO As Object
Dim OBJFolder As Object
Dim objSubFolder As Object
Dim i As Integer

    Dim rCell As Range
    Dim rRng As Range

    Set rRng = Sheet1.Range("A4:BZ4")

    For Each rCell In rRng.Cells
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set OBJFolder = objFSO.getfolder(Sheets("Sheet1").Range("A3").Value)
i = i + 1

'loops through each folder in the directory and prints their names and path
On Error GoTo handleCancel

For Each objSubFolder In OBJFolder.SubFolders
If InStr(1, objSubFolder.Name, "Plans", vbTextCompare) > 0 Or InStr(1, objSubFolder.Name, "Sketches", vbTextCompare) > 0 Then
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder path
    Cells(1 + 3, i) = objSubFolder.Path
    i = i

Else
End If

Next objSubFolder
Next rCell
handleCancel:
If Err = 18 Then
 MsgBox "You cancelled"
End If

End Sub

非常感谢任何帮助。

Answer 1

我没试过这个，但我认为使用Offset函数会给你相对于你正在计算的当前单元格的单元格。

Private Sub PrintFolders()
    Dim objFSO As Object
    Dim OBJFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

        Dim rCell As Range
        Dim rRng As Range

        Set rRng = Sheet1.Range("A4:BZ4")

        For Each rCell In rRng.Cells
    Application.StatusBar = ""
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set OBJFolder = objFSO.getfolder(rCell.Offset(-1, 0).Value)
    i = i + 1

    'loops through each folder in the directory and prints their names and path
    On Error GoTo handleCancel

    For Each objSubFolder In OBJFolder.SubFolders
    If InStr(1, objSubFolder.Name, "Plans", vbTextCompare) > 0 Or InStr(1, objSubFolder.Name, "Sketches", vbTextCompare) > 0 Then
    Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
        'print folder path
        Cells(1 + 3, i) = objSubFolder.Path
        i = i
    Else

    End If

    Next objSubFolder
    Next rCell
    handleCancel:
    If Err = 18 Then
     MsgBox "You cancelled"
    End If

    End Sub

VBA循环宏跨列

1 个答案: