根据单元格中的日期和编号自动生成文件夹

570964373

filtersh 发表于 2024-4-29 15:09
可以生成文件夹，但是生成稍微有点问题，所有的子文夹在2024对应的月份当中，但是执行程序后出现了2024/2 ...

额,这是我添加的输入更新测试用的,你把后几行删除了执行代码就行了

3190496160

filtersh 发表于 2024-4-29 15:02
非常感谢您的回复，但是我复制了代码后出现变量未定义。

最上面强制声明变量那句代码去掉就行了

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, strPath$
    ar = Range("B1", Cells(Rows.Count, "C").End(xlUp)).Value
    For i = 2 To UBound(ar)
        strPath = "E:\" & Year(ar(i, 1)) & "\" & Month(ar(i, 1)) & "委托单\" & ar(i, 2)
        MakeDirPath strPath
    Next i
End Sub

Function MakeDirPath(strDirName As String)
    Dim i&, strPath As String
    Do
        i = InStr(i + 1, strDirName & "\", "\")
        strPath = Left(strDirName, i - 1)
        If Right(strPath, 1) <> ":" And Dir(strPath, vbDirectory) = "" Then
            MkDir strPath
        End If
    Loop Until i >= Len(strDirName)
End Function

gwjkkkkk

请参考附件。。。

limonet

关键字：foreach

limonet

Sub limonet()
    Dim i%, Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Dic(Month(Cells(i, "B").Value) & "委托单\" & Cells(i, "C").Value) = ""
    Next i
    CreateObject("WScript.shell").Run "powershell ForEach ($S in ('" & Join(Dic.keys(), "','") & "')) {MD " & ThisWorkbook.Path & "\" & Year(Cells(i - 1, "B")) & "\" & "$S}", 0
End Sub