人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

次の動作をするExcel(エクセル)2007のVBA(マクロ)コードを教えてほしいです。


複数のテキストファイル(.txt)を一度に読み込んで、ある条件に従って
1つのシート(Sheet1)の特定のセルに表示するコードです。


※長くなってしまったので、続きを、このページ下部のコメント欄に書かせていただきます。
よろしくおねがいします。



●質問者: ヘンリ
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:Excel txt VBA いただきます つの
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Mook
●500ポイント ベストアンサー

運用面から少し仕様を変更してみました。

実際の要望に即さない場合は、コメント下さい。


まず管理EXCELがあるフォルダ下に「リスト更新」、「リスト更新済」の二つのフォルダをおきます。

変更する項目名+".txt" のファイルを、「リスト更新」フォルダ下に置きます。


マクロを実行すると、「リスト更新」下のファイルをスキャンし、該当列がない場合は警告を表示して終了します。

終了せずに処理を継続したい場合は、マクロ中の★の行を削除してください。


列の更新を順次実行し、処理が終わった txt ファイルは「リスト更新済」に移動します。

Option Explicit


'// コマンドボタン処理
'//-----------------------------------
Private Sub CommandButton1_Click()
 Const updateSourceFolder = "リスト更新"
 Const updateResultFolder = "リスト更新済"
 
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Dim objDic
 Set objDic = CreateObject("Scripting.Dictionary")

 Dim msg As String
 msg = ""

'// ファイルの確認
 Dim colName As String
 Dim colRange As Range
 Dim file As Object
 For Each file In fso.GetFolder(ThisWorkbook.Path & "\" & updateSourceFolder).Files
 colName = Replace(file.Name, ".txt", "")
 Set colRange = Rows(2).Find(colName, lookat:=xlWhole)
 If colRange Is Nothing Then
 msg = msg & colName & " "
 Else
 objDic.Add colName, file.Path
 End If
 Next
 If msg <> "" Then
 MsgBox "エクセルに [" & msg & "]のデータが存在しません!"
 Exit Sub '// ★該当しないファイルがあったら中止:継続の場合はこの行を削除
 End If
 
'// ファイルの読込み処理
 Dim r As Range
 Dim ar
 For Each r In Rows(2).Cells
 If r.Value <> "" Then
 If objDic.exists(r.Value) = True Then
 If MsgBox(r.Value & "のデータを上書きしてもいいですか?", vbYesNo, "更新確認") = vbYes Then
 r.Offset(1, 0).Resize(Rows.Count - 2, 1).ClearContents
 ar = Split(fso.OpenTextFile(objDic.Item(r.Value)).ReadAll(), vbNewLine)
 r.Offset(1, 0).Resize(UBound(ar) + 1, 1) = Application.Transpose(ar)
 MsgBox r.Value & "のデータを上書きしました!"
 fso.GetFile(objDic.Item(r.Value)).Move ThisWorkbook.Path & "\" & updateResultFolder & "\"
 End If
 End If
 End If
 Next
End Sub

仕様が異なる場合等は、コメント下さい。

◎質問者からの返答

Mookさんへ

ご回答ほんとうにありがとうございます。

すごい便利!の一言です。

もちろんエラーもありません。

あまりに使いやすいので、びっくりしました。

フォルダのこういう考え方があるんですね!

毎回、希望通りの仕様にしていただき感謝しています。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ