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

Question

ヘンリ

12

12もっと見る

500pt

コンピュータウェブ制作

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

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

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

回答の条件

1人5回まで

登録：2011/04/21 17:29:15
終了：2011/04/22 05:35:04

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ヘンリ 2011/04/21 17:32:12

(↓続きです)

たとえば、下のようにテキストファイルが2つあるとします。

(動物).txt
↓
犬
猫
虎
狸
狐

(かわいい).txt
↓
かわいい
カワイイ
可愛い
キュート

また、
次のようにデータが入っているエクセル表(Sheet1)があるとします。
↓
X2:(動物)　　　Y2:(かわいい)

この2つのテキストファイル・｢(動物).txt｣と｢(かわいい).txt｣をエクセル表(Sheet1)に一度に読み込んで、
テキストファイル名の｢(動物)｣とX2の｢(動物)｣が一致した場合、その真下のセルから(X3から)テキストファイルの中身を表示したいのです。
同じように、テキストファイル名の｢(かわいい)｣とY2の｢(かわいい)｣が一致した場合、その真下のセルから(Y3から)テキストファイルの中身を表示したいのです。

具体的には、

X2:(動物)　　　Y2:(かわいい)

↓↓↓

X2:(動物)　　　Y2:(かわいい)
X3:犬　　　　　Y3:かわいい
X4:猫　　　　　Y4:カワイイ
X5:虎　　　　　Y5:可愛い
X6:狸　　　　　Y6:キュート
X7:狐

上のように、エクセル表(Sheet1)に書き込まれれば(読み込まれれば)成功です。

【補足です】
●上の例では、2つのテキストファイル(.txt)を読み込みましたが、
実際には｢いくつのテキストファイルでも一度に読み込める｣ようにしたいです。

●｢いくつのテキストファイルでも一度に読み込める｣仕様というのが、
どの｢ActiveXコントロール｣になら可能なのか分からなかったので、説明が非常に曖昧になってしまいました。
｢いくつのテキストファイルでも一度に読み込める｣ようにする｢ActiveXコントロール｣が何なのか、
コードと併せてその方法を教えていただきたいです。
(例:(可能かどうか結局分からなかったのですが)テキストボックスを設置して、そこに直接テキストファイルごとドラッグアンドドロップして読み込む方法など、です。)

●読み込んだテキストファイル名が、｢それぞれの列の2行目のセル｣のデータと｢完全に一致した場合のみ｣、
その真下(3行目)のセルからテキストファイルの中身を表示したいです。
また、いきなりテキストファイルの中身を表示するのではなく、まずは(3行目から表示する前に)メッセージボックスが｢(その列の2行目のデータ)のデータを上書きしてもいいですか？｣と聞いてくる仕様にしたいです。

具体的には上記の例でいいますと、

<パターン1(エクセル表の2行目に｢(動物)｣のデータが存在しない場合)>
｢(動物).txt｣を読み込み
↓
メッセージボックス｢エクセルに、(動物)のデータが存在しません！｣

<パターン2(｢はい｣を選択した場合)>
｢(動物).txt｣を読み込み
↓
メッセージボックス｢(動物)のデータを上書きしてもいいですか？｣
↓
｢はい｣を選択
↓
2行目のデータが｢(動物)｣の列の、3行目から｢(動物).txt｣の中身を表示する(書きこむ)
(すでに以前のデータが表示されている場合は、一度3行目以降をクリアしてから新たに表示する)
↓
メッセージボックス｢(動物)のデータを上書きしました！｣

<パターン3(｢いいえ｣を選択した場合)>
｢(動物).txt｣を読み込み
↓
メッセージボックス｢(動物)のデータを上書きしてもいいですか？｣
↓
｢いいえ｣を選択した場合、その列では何もしない

<パターン4(複数のテキストファイルを読み込んで、1列目で｢はい｣を選択した場合)>
｢(動物).txt｣と｢(かわいい).txt｣を一度に読み込み
↓
メッセージボックス｢(動物)のデータを上書きしてもいいですか？｣
↓
｢はい｣を選択
↓
2行目のデータが｢(動物)｣の列の、3行目から｢(動物).txt｣の中身を表示する(書きこむ)
(すでに以前のデータが表示されている場合は、一度｢3行目以降をクリアしてから｣新たに表示する)
↓
メッセージボックス｢(動物)のデータを上書きしました！｣
↓
(一つ右の列の処理に移る)
メッセージボックス｢(かわいい)のデータを上書きしてもいいですか？｣
↓
・
・
・

<パターン5(複数のテキストファイルを読み込んで、1列目で｢いいえ｣を選択した場合)>
｢(動物).txt｣と｢(かわいい).txt｣を一度に読み込み
↓
メッセージボックス｢(動物)のデータを上書きしてもいいですか？｣
↓
｢いいえ｣を選択した場合、その列では何もしない
↓
(一つ右の列の処理に移る)
メッセージボックス｢(かわいい)のデータを上書きしてもいいですか？｣
↓
・
・
・

ここまでの条件を満たすVBAコードを知りたいです。
分かる方いましたら、どうかよろしくお願いします。

とても理解しにくい説明となってしまい申し訳ありません。
伝わっていない部分など多々あるかと思います。
疑問な点は、このコメント欄に書いていただけると非常に助かります。
Mook 2011/04/21 18:06:59

テキストファイルは EXCEL ファイルと同じフォルダにあると考えてよいでしょうか。
ヘンリ 2011/04/21 18:13:40

Mookさん

いつもありがとうございます。

>テキストファイルは EXCEL ファイルと同じフォルダにあると考えてよいでしょうか。
はい。
同じファイル(階層)にあると考えていただけると嬉しいです。
ヘンリ 2011/04/21 18:14:33

同じファイル(階層)
↓
同じフォルダ(階層)

の間違いでした。
すいません。
ヘンリ 2011/04/22 06:22:20

Mookさんへ

実用的すぎるご回答ありがとうございます。

何回か使っていて少し変更していただきたいところが出てきたのですが、
どうかよろしくおねがいします。

①｢リスト更新｣フォルダの中に、テキストファイルが1つもない場合は
メッセージボックスが｢上書きするデータ(テキストファイル)がありません！｣と表示するようにしていただきたいです。

②上書きするしないに関係なく、｢処理対象の列が目に見える｣ようにしていただきたいです。

たとえば、エクセルを新規に開いたときには見えない｢AA列｣が処理対象のときは、
｢AA列｣が見えるところにアクティブセルを移動するようにしてほしいのです。
(そのまま｢AA列｣にアクティブセルを移動していただけると分かりやすくて嬉しいです。)

>If MsgBox(r.Value & "のデータを上書きしてもいいですか？", vbYesNo, "更新確認") = vbYes Then
このメッセージ表示のときには、すでに対象列にアクティブセルが移動しているという仕様です。

アクティブセルは｢3行｣になっていると助かります。

Mookさん
もしお時間が空きましたら、
変更箇所を教えていただきたいです。
ヘンリ 2011/04/22 06:24:29

>アクティブセルは｢3行｣になっていると助かります。

｢3行｣
↓
｢3行目｣

でした。
訂正いたします。
ヘンリ 2011/04/22 06:50:11

Mookさんへ

立て続けに申し訳ありません。

次の変更もどうかおねがいしたいです。

●｢リスト更新｣、｢リスト更新済｣という2つのフォルダを使う仕様
　　↓
　｢最新置換データ｣という1つのフォルダだけを使う仕様

ですので、上書きしてもしなくても、1つのフォルダの中(テキストファイル)は何も変更されないということになります。
｢最新置換データ｣フォルダはずっとそのまま変化なしです。

何度もほんとうに申し訳ありません。
Mook 2011/04/22 07:51:58

下記のように変更してどうでしょうか。
-------------------------------
　　Const updateSourceFolder = "最新置換データ"　 ’★フォルダ名の変更
' ★★【削除】　　Const updateResultFolder = "リスト更新済"
　　　　：
　　　　：
　　　　：
’★For の実行の前に以下4行追加
　　If objDic.Count = 0 Then
　　　　MsgBox "上書きするデータ(テキストファイル)がありません！"
　　　　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 objDic… の後ろに以下2行追加
　　　　　　　　ActiveWindow.ScrollRow = 3
　　　　　　　　ActiveWindow.ScrollColumn = r.Column
　　　　：
　　　　：
　　　　：
' ★★【削除】　　　　　　　　fso.GetFile(objDic.Item(r.Value)).Move ThisWorkbook.Path & "\" & updateResultFolder & "\"
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next
ヘンリ 2011/04/22 16:50:40

Mookさん

修正コード本当にありがとうございます。

教えていただいた通り修正したところ、
完璧な動作をしてくれました。
ありがたいです。

何度も試したので間違いはないと思うのですが、
1つ確認させてください。

>’★For の実行の前に以下4行追加
>　　If objDic.Count = 0 Then
>　　　　MsgBox "上書きするデータ(テキストファイル)がありません！"
>　　　　Exit Sub
>　　End If

↑のコードは、以下のように組み込みました。

'// ファイルの読込み処理
Dim r As Range
Dim ar

If objDic.Count = 0 Then
　　　　MsgBox "上書きするデータ(テキストファイル)がありません！"
　　　　Exit Sub
　　End If

For Each r In Rows(2).Cells
If r.Value <> "" Then
If objDic.exists(r.Value) = True Then

エラーのない動作は確認できていますが、この組み込み方で合っていますでしょうか。
よろしくおねがいします。
Mook 2011/04/22 23:15:44

動作的には問題ありませんが、コード的には

'// ファイルの読込み処理
Dim r As Range
Dim ar

は For の直前の方がすっきりする気がします（気持ちだけの問題です）。
ヘンリ 2011/04/23 12:15:31

Mookさんへ

動作確認していただき、ありがとうございます。

さっそく、｢For の直前｣にしておきました!

間違っているかどうか再確認できて、すっきりしました。
Mook 2011/04/23 14:30:31

変更の際は盲目的にやるよりは、理由を理解された方が良いと思いますが、
先の修正等もそれぞれがどのような役割をしているか理解しておくと今後の役に
立つでしょう。

最後のコメントに関してですが、 Dim というのは変数の宣言です。
VB(VBA、VBS)　では変数宣言をしなくとも使うことができるでのすが、変数の書き
間違え等を防ぐ目的で、変数宣言をする習慣はあったほうがよいと思います。
これを強制するのが Option Explicit オプションです。

これがないと
For myInt=1 To 10
　　MsgBox myImt
Next
のようなタイプミスをしたときに、ずっと 0 が表示されるようなことがあります。

変数の宣言位置ですが、基本ルールは使用前に宣言すればどこでもよいです。
言語によっては処理を始める前にすべての宣言をしないとならない言語もあり、
それに起因するかどうかは分かりませんが、プロシージャの先頭にまとめて宣言を
する人も多いですが、このあたりは好みです。

私の場合は、使用しない変数宣言が残るのがいやですし、他の言語ではスコープ
（変数の有効範囲）をなるべく狭い範囲にすることが望ましいので、その影響もあり
処理の直前に書くようにしています(VB系ではどこに書いてもスコープは変わりませんが)。

ですので、間に Dim とコメントしかないので、動作的にはその位置はどちらでもよい
というのが回答になります。
ヘンリ 2011/04/23 14:56:34

Mookさん

VBAの大切なことを教えていただきありがとうございます。

Option Explicit オプションの使い方は、
参考書を読んでも理解できなかったので、分かりやすく説明していただいて大変ありがたいです。

変数の有効範囲についても、そもそも混乱してしまって変数をたくさん使うコードがまだ書けないのですが、
なんとなくコードのはじめにまとめて書くと決めつけていたので、
(今までのMookさんのコードを見ればそうではないことが明らかなのですが)

とても勉強になります。

また、どうかよろしくおねがいいたします。

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

Mook · Accepted Answer · 2011-04-21T22:01:07+09:00

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

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

まず管理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

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

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

ベストアンサー

Mook13143932011/04/21 22:01:07

コメント（13件)

この質問への反応（ブックマークコメント）