ダイアログボックスが自動的に開き選択ファイル(フルパス名)
が表示されるVBEがあるんですが、(下記参照)改良したい点がありますので見て下さい。
Sub Excelファイル()
Dim i As Integer
Dim xFileNames As Variant, xFile As Variant, xDir As String
With Application.FileDialog(msoFileDialogFilePicker)
xFileNames = Application.GetOpenFilename( _
FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", MultiSelect:=True)
If IsArray(xFileNames) Then
i = 1
For Each xFile In xFileNames 'Xファイルネーム(フルパス名)すべての要素に同じ処理を繰り返す
xDir = Dir(xFile) '変数xDir=xファイル名(ファイル名)
If i = 1 Then 'i=1の場合(選択ファイル一つ目の場合)
Cells(i, 1).Value = Replace(xFile, xDir, "") 'A列の中にフルパスからファイル名を取り除いた値を表示する
Cells(i, 1).Offset(1).Value = xDir '1行下の値がファイル名である。
i = i + 2 'iに2を加えてループ
Else '違う場合
Cells(i, 1).Value = xDir 'A列に順にファイル名を表示する
i = i + 1 'iに1を加えてループ
End If
Next xFile 'xファイルに戻る
End If
Cells(Rows.Count, 1).End(xlUp).Offset(1).Activate 'データの最終行をA列で検知して一つ下の行がアクティブセル
End With
End Sub
この命令文だとA1セルから縦に順にフルパス名が表示され、データの最終行の一つ下がアクティブセルになるようになっています。
改良したい点は、A列限定ではなくアクティブセルから順に上記と同じようにフルパス名が表示され、データの最終行の一つ下にアクティブセルがくるVBEに改良したいです。
※上記VBEのようにアクティブセルに選択ファイル一つ目のフルパスからファイル名を取り除いたデータを表示し、
Offset(1,0)に選択ファイル一つ目のファイル名のみを表示、Offset2以降は選択ファイル2つ目以降のファイル名だけを表示するようにする。
VBA初心者なので、上記のようにそれほど難しくない構文で仕上げたいのですが、
もしできる方いましたら教えてください。
よろしくお願いいたします。
A 回答 (1件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
質問投稿後かなり日数がたっていますが今でもお役にたてるでしょうか。
とりあえず最低限の修正をしてみました。
修正点は以下の通りです。
1.iの型はIntegerからLongに(32768行以下に対応)
2.i(行番号)の初期値を1からActiveCell.Rowに変更。
(選択ファイル一つ目かどうかの判定も同様に変更)
3.Cellsの列番号を1からActivecell.Columnに変更
コードは以下の通りです。
Sub Excelファイル()
Dim i As Long
Dim xFileNames As Variant, xFile As Variant, xDir As String
With Application.FileDialog(msoFileDialogFilePicker)
xFileNames = Application.GetOpenFilename( _
FileFilter:="Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", MultiSelect:=True)
If IsArray(xFileNames) Then
i = ActiveCell.Row
For Each xFile In xFileNames 'Xファイルネーム(フルパス名)すべての要素に同じ処理を繰り返す
xDir = Dir(xFile) '変数xDir=xファイル名(ファイル名)
If i = ActiveCell.Row Then 'i=アクティブセルの行の場合(選択ファイル一つ目の場合)
Cells(i, ActiveCell.Column).Value = Replace(xFile, xDir, "") 'A列の中にフルパスからファイル名を取り除いた値を表示する
Cells(i, ActiveCell.Column).Offset(1).Value = xDir '1行下の値がファイル名である。
i = i + 2 'iに2を加えてループ
Else '違う場合
Cells(i, ActiveCell.Column).Value = xDir 'A列に順にファイル名を表示する
i = i + 1 'iに1を加えてループ
End If
Next xFile 'xファイルに戻る
End If
Cells(Rows.Count, ActiveCell.Column).End(xlUp).Offset(1).Activate 'データの最終行をA列で検知して一つ下の行がアクティブセル
End With
End Sub
ところで、最後のアクティブセルを移動するところですが、このプロシージャを複数回使用してその結果を連続したセルに表示するなら、以下のようにした方がいいのではないでしょうか。
Cells(i, ActiveCell.Column).Activate
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA 参照先で選んだファイルをコピーし、出力先に別名で保存したい 8 2022/05/13 20:37
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Excel(エクセル) フォルダ内のワードファイルをPDFに一括変換するVBA 3 2023/06/09 16:51
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています 17 2022/12/07 12:03
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/06 17:46
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
特定のセルが空白だったら、そ...
-
ExcelVBAを使って、値...
-
i=cells(Rows.Count, 1)とi=cel...
-
VBAでセルをクリックする回...
-
Excelのハイパーリンクにマクロ...
-
【Excel VBA】指定行以降をクリ...
-
【Excel】指定したセルの名前で...
-
Excelで指定した日付から過去の...
-
EXCELで変数をペーストしたい
-
Excel vbaで特定の文字以外が入...
-
Sub 要具ライフ() ActiveSheet....
-
TODAY()で設定したセルの日付...
-
【VBA】指定したセルと同じ値で...
-
エクセル マクロで セルの範...
-
VBAの計算で@が出てしまう件
-
DataGridViewのセル編集完了後...
-
任意フォルダから画像をすべて...
-
セルに抜けた番号の代わりに空...
-
DataGridViewで右寄せ左寄せが...
-
”戻り値”が変化したときに、マ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
特定のセルが空白だったら、そ...
-
【Excel VBA】指定行以降をクリ...
-
i=cells(Rows.Count, 1)とi=cel...
-
【Excel】指定したセルの名前で...
-
Excelで指定した日付から過去の...
-
特定の文字を条件に行挿入とそ...
-
Excel VBA、 別ブックの最終行...
-
EXCELで変数をペーストしたい
-
Excelのプルダウンで2列分の情...
-
Excel vbaで特定の文字以外が入...
-
TODAY()で設定したセルの日付...
-
screenupdatingが機能しなくて...
-
DataGridViewの各セル幅を自由...
-
Sub 要具ライフ() ActiveSheet....
-
【EXCEL VBA】Range("A:A").Fi...
-
VBAを使用した時間管理
-
VBAでセルをクリックする回...
-
セル色なしの行一括削除
-
エクセルVBAでコピーして順...
おすすめ情報