スプレッドシートデータからフォルダ階層を作成する

Question

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

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でかなり新しいです。

ありがとうございます！

Answer 1

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 

Answer 2

これを試してください。それはあなたが列 "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 

Answer 3

私は、はるかに効率的と同じ、以下のコードを行うためのより良い方法を見つけました。 "" ""は、フォルダ名に空白が含まれている場合にパスを引用することに注意してください。コマンドラインmkdirは、必要に応じて、すべてのパスを存在させるために中間フォルダを作成します。したがって、パスを指定するためにセパレータとして\を使用してセルを連結してから、