123123456地方

13570449347

123 放大否

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=73cffde5
链接内容供参考

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, strPath$, strMakePath$
   
    strPath = ThisWorkbook.Path & "\"
    ar = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    For i = 2 To UBound(ar)
        If IsDate(ar(i, 1)) Then
            strMakePath = strPath & Month(ar(i, 1)) & "月\" & Format(ar(i, 1), "yyyy年m月d日")
            Call MakeDirPath(strMakePath)
        End If
    Next i

    Beep
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

。。。。。。。。。。。。

shiruiqiang

===============

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.5
   
2.     Set fso = CreateObject("Scripting.FileSystemObject")
   
3.     p = ThisWorkbook.Path & ""
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 1)
   
6.     For i = 2 To UBound(arr)
   
7.         rq = Format(arr(i, 1), "yyyy年m月d日")
   
8.         p1 = p & rq & ""
   
9.         If Not fso.FolderExists(p1) Then fso.CreateFolder p1
   
10.     Next
    
11.     MsgBox "OK！"
    
12. End Sub
    
13. 
    

复制代码

limonet

关键字：foreach

limonet

Sub limonet()
    CreateObject("WScript.shell").Run "powershell ForEach ($S in (1..31)) { MD " & ThisWorkbook.Path & "\'" & Format(Date, "yyyy年m月") & "'$S'日'}", 0
End Sub