D盘999个文件夹,遍历1737,End(xlUp).Row是67921

ning84

D盘共999个文件夹
遍历方法编程,=COUNT(A:A)结果1737
使用End(xlUp).Row方法结果太离谱，是67921

1. Sub Test()
   
2.     Dim Rr
   
3.          With Sheet3
   
4.             .Cells.Clear
   
5.             .Cells.Font.Size = 9
   
6.          End With
   
7.          
   
8. 
   
9.          'Stop
   
10.     TraverseSubFolders "D:", 10 ' 替换成你想要遍历的文件夹路径
    
11. End Sub
    
12. 
    
13. Sub TraverseSubFolders(FolderPath As String, Rr)
    
14.     Dim Rng As Range
    
15. 
    
16.     Dim ii As Integer
    
17.     Dim curFolder As Object
    
18.     Dim SubFolder As Object
    
19.    
    
20.     Set curFolder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)
    
21.    
    
22.     ' 遍历当前文件夹的子文件夹
    
23.     For Each SubFolder In curFolder.SubFolders
    
24.         ' 处理子文件夹
    
25.         Debug.Print SubFolder.Path
    
26.         If InStr(SubFolder.Path, "System Volume Information") = 0 Then
    
27.               Sheet3.Cells(Rr + ii, 1) = ii
    
28.               
    
29.               Sheet3.Cells(Rr + ii, 2) = SubFolder.Path
    
30.               
    
31.               Debug.Print Sheet3.Cells(Rr + ii, 1).Address
    
32.         ii = ii + 1
    
33.         ' 递归调用，继续遍历子文件夹的子文件夹
    
34.         TraverseSubFolders SubFolder.Path, Rr
    
35.         End If
    
36.     Next SubFolder
    
37.     Rr = Sheet3.Cells(655555, 1).End(xlUp).Row + 3
    
38.    
    
39. End Sub
    

复制代码

ning84

67921记录，问题是没有应用好
没有用好，End(xlUp).Row加了271个空单元行。

1. 
   
2. Sub tmpTraverseSubFolders(FolderPath As String, Rr)
   
3.     Dim Rng As Range
   
4. 
   
5.     Dim ii As Integer
   
6.     Dim CurFolder As Object
   
7.     Dim SubFolder As Object
   
8.    
   
9.     Set CurFolder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)
   
10.    
    
11.     ' 遍历当前文件夹的子文件夹
    
12.     For Each SubFolder In CurFolder.SubFolders
    
13.         ' 处理子文件夹
    
14.         Debug.Print SubFolder.Path
    
15.         If InStr(SubFolder.Path, "System Volume Information") = 0 Then
    
16.               Sheet3.Cells(Rr + ii, 1) = ii
    
17.               
    
18.               Sheet3.Cells(Rr + ii, 2) = SubFolder.Path
    
19.               
    
20.               Debug.Print Sheet3.Cells(Rr + ii, 1).Address
    
21.         ii = ii + 1
    
22.         ' 递归调用，继续遍历子文件夹的子文件夹
    
23.         TraverseSubFolders SubFolder.Path, Rr
    
24.         End If
    
25.     Next SubFolder
    
26.     Rr = Sheet3.Cells(655555, 1).End(xlUp).Row + 3
    
27.    
    
28. End Sub
    
29. 
    

复制代码

liulang0808

楼主的具体要做什么，输出的结果正常是怎样的，建议描述清楚
目前附件里代码挺多的，不确认楼主具体做什么，对应关系怎样的
            Sheet3.Cells(Rr + ii, 1) = ii 修改成下方代码
            Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1) = ii
            
              
            Sheet3.Cells(Rr + ii, 2) = SubFolder.Path修改成下方代码
            Sheet3.Cells(Rows.Count, 2).End(xlUp).Offset(1) = SubFolder.Path

以上两行代码修改，楼主可以尝试看看，楼主的思路不了解，不确定是否可行的

ning84

liulang0808 发表于 2024-5-3 11:46
楼主的具体要做什么，输出的结果正常是怎样的，建议描述清楚
目前附件里代码挺多的，不确认楼主具体做什么 ...

非常感谢Rows.Count的帮助.

1. Sub Test1()
   
2.     Dim Fso As FileSystemObject
   
3.     With Sheet3
   
4.          .Cells.Clear
   
5.          .Cells.Font.Size = 9
   
6.          .Cells(10, 1) = "A"
   
7.          .Cells(10, 2) = "B"
   
8.          .Cells(10, 3) = "C"
   
9.          tmpTraverseSubFolders "D:"
   
10.          ''
    
11.          Debug.Print "=count(a11:A" & .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row & ")"
    
12.          .Cells(3, 1) = "=count(a11:A" & .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row & ")"
    
13.     End With
    
14.    
    
15.    
    
16. End Sub
    
17. 
    
18. Function tmpTraverseSubFolders(FolderPath As String)
    
19.     Dim Rng As Range
    
20. 
    
21.     Dim ii As Integer
    
22.     Dim CurFolder As Object
    
23.     Dim SubFolder As Object
    
24.    
    
25.     Set CurFolder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)
    
26.    
    
27.     ' 遍历当前文件夹的子文件夹
    
28.     For Each SubFolder In CurFolder.SubFolders
    
29.         If InStr(SubFolder.Path, "System Volume Information") = 0 Then
    
30.               Set Rng = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
31.               Rng(, 1) = Rng.Row - 10
    
32.               Rng(, 2) = SubFolder.Path
    
33.               tmpTraverseSubFolders SubFolder.Path
    
34.         End If
    
35.     Next SubFolder
    
36.    
    
37.    
    
38. End Function
    

复制代码