ExcelVBA 配列を使用した高速処理①（フルパスを￥で区切って各セルに入力）

■フルパスを記載したファイル→￥で分割したファイルに編集する

↓

■手順(このページの一番下のサンプルコードの解説）
①バリアント型の変数「temp」にフルパスが記載されている全範囲を格納する
※格納すると自動的に「temp」は2次元配列になる（1次元のインデックスのスタート値・２次元のインデックスのスタート値ともに１となる）

 temp = Range(Cells(intBasisPointRaw, intBasisPointCol), Cells(lngLastRow, intBasisPointCol))

②各階層に分割したパスの格納先の変数をVariant型の２次元配列として宣言しておく（固定値でしか宣言できないため）

'各階層に分割したパスを格納する２次元配列（最終行を多めに設定）
    Dim arrayFolders(1 To 100, 1 To 10)

③Split関数で「￥」を区切り文字として各階層のフォルダ名ごとに区切った文字列をバリアント型配列「arraysplit」に格納→さらに区切った配列をフルパス１行分ごとにバリアント型配列「arrayFolders」に格納

 Dim i As Integer
    Dim j As Integer    
    For i = 1 To UBound(temp)
        'フルパスを「￥」を区切り文字として配列に変換
        arraySplit = Split(temp(i, 1), "\")
        '配列に変換したフルパスを２次元配列に格納
        For j = 0 To UBound(arraySplit)
            arrayFolders(i, j + 1) = arraySplit(j)
        Next j
        '配列を初期化
        Erase arraySplit
    Next i

④各階層ごとに区切った編集後のフルパスが格納されたVariant型変数「arrayFolder」の値を貼り付け先ファイルのセルに貼り付ける

'Variant型配列に格納した値をコピー先のファイルに貼り付ける
    sh.Range(Cells(intBasisPointRaw - 1, intBasisPointCol - 2), Cells(lngLastRow - 1, 10)) = arrayFolders
    wb.Save

■サンプルコード
configモジュール

Option Explicit
'基点となるセルを定数設定
Public Const intBasisPointCol As Integer = 3
Public Const intBasisPointRaw As Integer = 3

呼び出し元プロシージャ

Option Explicit

Sub edifFile()

    Dim strResult As String         'ファンクションの実行結果
    Dim strPath As String           'フルパスを記載した元ファイル
    Dim strPath2 As String          '編集したパスを記載する抽出先ファイル
    Dim strSheetName As String      '元ファイルのシート名
    Dim strSheetName2 As String     '抽出先ファイルのシート名
    
    '各変数の値設定
    strPath = "C:\Users\yamada\OneDrive\デスクトップ\ExcelVBAプロジェクト\Splitテスト\フルパス（ランダム).xlsx"
    strPath2 = "C:\Users\yamada\OneDrive\デスクトップ\ExcelVBAプロジェクト\Splitテスト\新規 Microsoft Excel ワークシート.xlsx"
    strSheetName = "Sheet1"
    strSheetName2 = "Sheet1"
    'ファンクション呼び出し
    strResult = fncEditFile(strPath, strSheetName, strPath2, strSheetName2)
    'ファンクションの実行結果を表示
    MsgBox strResult
    
End Sub

ファンクションプロシージャ

Function fncEditFile(strPath As String, strSheetName As String, _
                     strPath2 As String, strSheetName2 As String) As String
'---------------------------------------------------
'機能：対象ファイルに記載されているフルパスの一覧表より１行づつフルパスの
'      文字列を抜き出し「￥」を区切り文字としてフォルダ階層ごとに分割して
'      抽出先ファイルのセルに書き出し、最後に昇順でソートをかける
'引数1：対象ファイルのパス
'引数1：対象ファイルのシート名
'引数1：抽出先ファイルのパス
'引数1：抽出先ファイルのシート名
'戻り値：処理結果（正常動作の場合は「OK」エラーの場合は「NG」）
'---------------------------------------------------------
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim lngLastRow As Integer
    '対象ファイルのフルパス記載のある範囲を格納する変数
    Dim temp As Variant
    'フルパスを「￥」を区切り文字として配列にして格納する変数
    Dim arraySplit As Variant
    '各階層に分割したパスを格納する２次元配列（最終行を多めに設定）
    Dim arrayFolders(1 To 100, 1 To 10)    
    On Error GoTo ErrHandler    
    'コピー元ファイルを開く
    Set wb = Workbooks.Open(strPath)
    Set sh = wb.Sheets(strSheetName)
    'コピーした値をVariant型配列に格納
    With sh
        '最終行を取得
       lngLastRow = .Cells(Rows.Count, intBasisPointCol).End(xlUp).Row
       'フルパスの記載されている範囲をバリアント型変数に格納（２次元配列となる）
       temp = Range(Cells(intBasisPointRaw, intBasisPointCol), Cells(lngLastRow, intBasisPointCol))
    End With    
    '------------------------------------------------------------
    'フルパスを\マークで区切って配列にし、フルパスの行数分をバリアント型の２次元配列に格納
    Dim i As Integer
    Dim j As Integer    
    For i = 1 To UBound(temp)
        'フルパスを「￥」を区切り文字として配列に変換
        arraySplit = Split(temp(i, 1), "\")
        '配列に変換したフルパスを２次元配列に格納
        For j = 0 To UBound(arraySplit)
            arrayFolders(i, j + 1) = arraySplit(j)
        Next j
        '配列を初期化
        Erase arraySplit
    Next i
   '----------------------------------------------------------
   'コピー元ブックを閉じる
    wb.Close
    Set wb = Nothing    
    'コピー先ファイルを開く
    Set wb = Workbooks.Open(strPath2)
    Set sh = wb.Sheets(strSheetName2)
    With sh
        '項目名を設定
        .Cells(1, 1) = "第1階層"
        .Cells(1, 2) = "第2階層"
        .Cells(1, 3) = "第3階層"
        .Cells(1, 4) = "第4階層"
        .Cells(1, 5) = "第5階層"
        .Cells(1, 6) = "第6階層"
        .Cells(1, 7) = "第7階層"
        .Cells(1, 8) = "第8階層"
        .Cells(1, 9) = "第9階層"
        .Cells(1, 10) = "第10階層"
    End With
    'Variant型配列に格納した値をコピー先のファイルに貼り付ける
    sh.Range(Cells(intBasisPointRaw - 1, intBasisPointCol - 2), Cells(lngLastRow - 1, 10)) = arrayFolders
    wb.Save
    '---------------------------------------------------------
    '昇順でソートする        
    'ソートの条件を設定
    With ActiveSheet.Sort.SortFields    
        '条件設定をクリア
        .Clear        
        '1～10列目まで同じソートの条件設定をするため繰り返し処理
        For i = 1 To 10
        .Add Key:=Cells(1, i), _
             SortOn:=xlSortOnValues, _
             Order:=xlAscending, _
             DataOption:=xlSortNormal
        Next        
     End With        
    'ソートをかける
    With ActiveSheet.Sort
        .SetRange Range(Cells(1, 1), Cells(lngLastRow, 10))
        .Header = xlYes
        .Orientation = xlTopToBottom
        .Apply
    End With     
    '----------------------------------------------------------
    wb.Close True
    Set wb = Nothing    
    fncEditFile = "OK"
    Exit Function    
ErrHandler:
    fncEditFile = Err.Number & vbCrLf & Err.Description         
End Function