字典运用错误：分列含有文件的子目录和文件名

weiyingde

学习字典遇到错误，请求大咖援手。
目标文档在sheet3。
要求：A列列出含有文件的子目录，B列将该目录下所有文件名用“|”分界练成字符串。
错误：B列只出现“|”和最后一个文件名的字符串。
原因：arr装入字典Dic错误，出现在exists的运用上。
附件如下：
先谢了。

weiyingde

自我解决

Dim arr(), Nb
Sub 获取2()
'On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
    Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
    arr = Application.Transpose(arr)
    'Sheet2.[a1].Resize(Nb, 2) = arr
    For i = 1 To UBound(arr)
       If dic.exists(arr(i, 1)) Then
           dic(arr(i, 1)) = dic(arr(i, 1)) & "|" & arr(i, 2)
       Else
          dic(arr(i, 1)) = arr(i, 2)
       End If
    Next
    ct = dic.Count
    tm = dic.items
    ky = dic.keys
    Sheet3.[a1].Resize(ct, 1) = Application.Transpose(ky)
    Sheet3.[b1].Resize(ct, 1) = Application.Transpose(tm)
    Erase arr
    Nb = 0
    Set dic = Nothing
    Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
    Set Fso = CreateObject("scripting.filesystemobject")
    Set ff = Fso.GetFolder(pth)
    For Each f In ff.Files
        Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理
        'Cells(Rows.Count, 1).End(3).Offset(1) = f.Name
        'Cells(Rows.Count, 2).End(3).Offset(1) = f
         Nb = Nb + 1
         ReDim Preserve arr(1 To 2, 1 To Nb)
         arr(1, Nb) = Left(f, Len(f) - Len(Split(f, "\")(UBound(Split(f, "\")))))
         arr(2, Nb) = Split(f.Name, ".")(0)
    Next f
    For Each fd In ff.SubFolders
        Getfd (fd)
    Next fd
End Sub

Private Sub CommandButton1_Click()
获取2
End Sub

ykcbf1100

需求有点奇怪

weiyingde

ykcbf1100 发表于 2024-8-9 19:32
需求有点奇怪

没有别的，学一学dictionary的用法。