1

フォルダーを作成したいデータを左から右に整理したスプレッドシートがいくつかあります。それが行の終わりでない限り、すべてのレコードは空白なしで完了しているので、私は次の何かを狙っています：

Col1     Col2     Col3
------   ------   ------
Car      Toyota   Camry
Car      Toyota   Corolla
Truck    Toyota   Tacoma
Car      Toyota   Yaris
Car      Ford     Focus
Car      Ford     Fusion
Truck    Ford     F150

Car
    Toyota
        Camry
        Corolla
        Yaris
    Ford
        Focus
        Fusion
Truck
    Toyota
        Tacoma
    Ford
        F-150
...

これに対する唯一の注意点は、約15列あり、一部のエントリは列3または4で終了するため、これらのフォルダーのみを作成する必要があることです。

誰かがこのリクエストを手伝ってもらえますか？私はプログラミングに不慣れではありませんが、VBAはまだかなり新しいです。

ありがとう！

4

3 に答える 3

5 
Sub Tester()

    Const ROOT_FOLDER = "C:\TEMP\"
    Dim rng As Range, rw As Range, c As Range
    Dim sPath As String, tmp As String

    Set rng = Selection

    For Each rw In rng.Rows
        sPath = ROOT_FOLDER
        For Each c In rw.Cells
            tmp = Trim(c.Value)
            If Len(tmp) = 0 Then
                Exit For
            Else
                sPath = sPath & tmp & "\"
                If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath
            End If
        Next c
    Next rw
End Sub
于 2012-04-10T21:01:27.700 に答える
2

私は、同じ、より少ないコード、はるかに効率的な方法を見つけることができました。「""」は、フォルダ名に空白が含まれている場合に備えて、パスを引用符で囲むことに注意してください。コマンドラインmkdirは、パス全体を存在させるために必要な場合、中間フォルダーを作成します。したがって、必要なのは、\を区切り文字として使用してセルを連結し、パスを指定してから、

If Dir(YourPath, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & YourPath & """")
End If
于 2014-11-14T16:55:40.173 に答える
1

これを試してみてください。列「A」から開始し、C：\のディレクトリも開始することを前提としています（sDir変数を使用）。必要に応じて、「C：\」をベースポイントにしたいものに変更するだけです。

Option Explicit

Sub startCreating()
    Call CreateDirectory(2, 1)
End Sub

Sub CreateDirectory(ByVal row As Long, ByVal col As Long, Optional ByRef path As String)
    If (Len(ActiveSheet.Cells(row, col).Value) <= 0) Then
        Exit Sub
    End If

    Dim sDir As String

    If (Len(path) <= 0) Then
        path = ActiveSheet.Cells(row, col).Value
        sDir = "C:\" & path
    Else
        sDir = path & "\" & ActiveSheet.Cells(row, col).Value
    End If


    If (FileOrDirExists(sDir) = False) Then
        MkDir sDir
    End If

    If (Len(ActiveSheet.Cells(row, col + 1).Value) <= 0) Then
        Call CreateDirectory(row + 1, 1)
    Else
        Call CreateDirectory(row, col + 1, sDir)
    End If
End Sub


' Function thanks to: http://www.vbaexpress.com/kb/getarticle.php?kb_id=559
Function FileOrDirExists(PathName As String) As Boolean
     'Macro Purpose: Function returns TRUE if the specified file
     '               or folder exists, false if not.
     'PathName     : Supports Windows mapped drives or UNC
     '             : Supports Macintosh paths
     'File usage   : Provide full file path and extension
     'Folder usage : Provide full folder path
     '               Accepts with/without trailing "\" (Windows)
     '               Accepts with/without trailing ":" (Macintosh)

    Dim iTemp As Integer

     'Ignore errors to allow for error evaluation
    On Error Resume Next
    iTemp = GetAttr(PathName)

     'Check if error exists and set response appropriately
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select

     'Resume error checking
    On Error GoTo 0
End Function
于 2012-04-10T20:56:39.450 に答える