| |
前任者からもらったファイルなのですが
下記のように同じ作業を繰り返す長い状態にあります
これをうまく纏める方法を教えていただけませんでしょうか
Const cnsTITLE = "フォルダ内のファイル名一覧取得"
Const cnsDIR = "\*.*"
Dim xlAPP As Application
Dim strFILENAME1, strFILENAME2, strFILENAME3, strFILENAME4, strFILENAME5, strFILENAME6, strFILENAME7, strFILENAME8, strFILENAME9, strFILENAME10, strFILENAME11, strFILENAME12 As String
Dim GYO1, GYO2, GYO3, GYO4, GYO5, GYO6, GYO7, GYO8, GYO9, GYO10, GYO11, GYO12 As Long
Set xlAPP = Application
' InputBoxでﾌｫﾙﾀﾞ指定を受ける
If StrConv(Dir1, vbUpperCase) = "FALSE" Then Exit Sub
' ﾌｫﾙﾀﾞの存在確認
If Dir(Dir1, vbDirectory) = "" Then
MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE
Exit Sub
End If
' 先頭のﾌｧｲﾙ名の取得
strFILENAME1 = Dir(Dir1 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME1 <> ""
' 行を加算
GYO1 = GYO1 + 1 ' 先頭は1行目
Cells(GYO1, "AP").Value = strFILENAME1
' 次のﾌｧｲﾙ名を取得
strFILENAME1 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME2 = Dir(Dir2 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME2 <> ""
' 行を加算
GYO2 = GYO2 + 1 ' 先頭は1行目
Cells(GYO2, "AQ").Value = strFILENAME2
' 次のﾌｧｲﾙ名を取得
strFILENAME2 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME3 = Dir(Dir3 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME3 <> ""
' 行を加算
GYO3 = GYO3 + 1 ' 先頭は1行目
Cells(GYO3, "AR").Value = strFILENAME3
' 次のﾌｧｲﾙ名を取得
strFILENAME3 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME4 = Dir(Dir4 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME4 <> ""
' 行を加算
GYO4 = GYO4 + 1 ' 先頭は1行目
Cells(GYO4, "AS").Value = strFILENAME4
' 次のﾌｧｲﾙ名を取得
strFILENAME4 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME5 = Dir(Dir5 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME5 <> ""
' 行を加算
GYO5 = GYO5 + 1 ' 先頭は1行目
Cells(GYO5, "AT").Value = strFILENAME5
' 次のﾌｧｲﾙ名を取得
strFILENAME5 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME6 = Dir(Dir6 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME6 <> ""
' 行を加算
GYO6 = GYO6 + 1 ' 先頭は1行目
Cells(GYO6, "AU").Value = strFILENAME6
' 次のﾌｧｲﾙ名を取得
strFILENAME6 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME7 = Dir(Dir7 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME7 <> ""
' 行を加算
GYO7 = GYO7 + 1 ' 先頭は1行目
Cells(GYO7, "AV").Value = strFILENAME7
' 次のﾌｧｲﾙ名を取得
strFILENAME7 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME8 = Dir(Dir8 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME8 <> ""
' 行を加算
GYO8 = GYO8 + 1 ' 先頭は1行目
Cells(GYO8, "AW").Value = strFILENAME8
' 次のﾌｧｲﾙ名を取得
strFILENAME8 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME9 = Dir(Dir9 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME9 <> ""
' 行を加算
GYO9 = GYO9 + 1 ' 先頭は1行目
Cells(GYO1, "AX").Value = strFILENAME9
' 次のﾌｧｲﾙ名を取得
strFILENAME9 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME10 = Dir(Dir10 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME10 <> ""
' 行を加算
GYO10 = GYO10 + 1 ' 先頭は1行目
Cells(GYO1, "AY").Value = strFILENAME10
' 次のﾌｧｲﾙ名を取得
strFILENAME10 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME11 = Dir(Dir11 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME11 <> ""
' 行を加算
GYO11 = GYO11 + 1 ' 先頭は1行目
Cells(GYO11, "AZ").Value = strFILENAME11
' 次のﾌｧｲﾙ名を取得
strFILENAME11 = Dir()
Loop
' 先頭のﾌｧｲﾙ名の取得
strFILENAME12 = Dir(Dir12 & cnsDIR, vbNormal)
' ﾌｧｲﾙが見つからなくなるまで繰り返す
Do While strFILENAME12 <> ""
' 行を加算
GYO12 = GYO12 + 1 ' 先頭は1行目
Cells(GYO12, "BA").Value = strFILENAME12
' 次のﾌｧｲﾙ名を取得
strFILENAME12 = Dir()
Loop
Columns("AP").Sort Key1:=Range("AP1") 'AG行をソートします
FI1 = Worksheets("test").Cells(1, "AP").End(xlDown)
Columns("AQ").Sort Key1:=Range("AQ1") 'AG行をソートします
FI2 = Worksheets("test").Cells(1, "AQ").End(xlDown)
Columns("AR").Sort Key1:=Range("AR1") 'AG行をソートします
FI3 = Worksheets("test").Cells(1, "AR").End(xlDown)
Columns("AS").Sort Key1:=Range("AS1") 'AG行をソートします
FI4 = Worksheets("test").Cells(1, "AS").End(xlDown)
Columns("AT").Sort Key1:=Range("AT1") 'AG行をソートします
FI5 = Worksheets("test").Cells(1, "AT").End(xlDown)
Columns("AU").Sort Key1:=Range("AU1") 'AG行をソートします
FI6 = Worksheets("test").Cells(1, "AU").End(xlDown)
Columns("AV").Sort Key1:=Range("AV1") 'AG行をソートします
FI7 = Worksheets("test").Cells(1, "AV").End(xlDown)
Columns("AW").Sort Key1:=Range("AW1") 'AG行をソートします
FI8 = Worksheets("test").Cells(1, "AW").End(xlDown)
Columns("AX").Sort Key1:=Range("AX1") 'AG行をソートします
FI9 = Worksheets("test").Cells(1, "AX").End(xlDown)
Columns("AY").Sort Key1:=Range("AY1") 'AG行をソートします
FI10 = Worksheets("test").Cells(1, "AY").End(xlDown)
Columns("AZ").Sort Key1:=Range("AZ1") 'AG行をソートします
FI11 = Worksheets("test").Cells(1, "AZ").End(xlDown)
Columns("BA").Sort Key1:=Range("BA1") 'AG行をソートします
FI12 = Worksheets("test").Cells(1, "BA").End(xlDown)
ファイル無:
|
|
みね
- 09/3/27(金) 17:10 -
