Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2135 / 13645 ツリー ←次へ | 前へ→

【69705】複数のブックから1つのシートに 11/8/23(火) 12:06 質問[未読]
【69706】Re:複数のブックから1つのシートに UO3 11/8/23(火) 12:25 発言[未読]
【69707】Re:複数のブックから1つのシートに 11/8/23(火) 13:22 発言[未読]
【69709】Re:複数のブックから1つのシートに UO3 11/8/23(火) 15:03 発言[未読]
【69710】Re:複数のブックから1つのシートに 11/8/23(火) 15:59 発言[未読]
【69713】Re:複数のブックから1つのシートに UO3 11/8/23(火) 17:30 発言[未読]
【69715】Re:複数のブックから1つのシートに 11/8/23(火) 17:53 発言[未読]
【69711】Re:複数のブックから1つのシートに UO3 11/8/23(火) 15:59 回答[未読]
【69712】Re:複数のブックから1つのシートに 11/8/23(火) 17:26 お礼[未読]
【69714】Re:複数のブックから1つのシートに UO3 11/8/23(火) 17:42 発言[未読]
【69716】Re:複数のブックから1つのシートに 11/8/23(火) 18:44 発言[未読]
【69725】Re:複数のブックから1つのシートに UO3 11/8/24(水) 16:19 発言[未読]
【69726】Re:複数のブックから1つのシートに 11/8/24(水) 17:36 発言[未読]
【69733】Re:複数のブックから1つのシートに UO3 11/8/25(木) 10:48 回答[未読]
【69735】Re:複数のブックから1つのシートに 11/8/25(木) 11:06 発言[未読]
【69736】Re:複数のブックから1つのシートに UO3 11/8/25(木) 13:14 発言[未読]
【69734】Re:複数のブックから1つのシートに UO3 11/8/25(木) 10:56 発言[未読]
【69737】Re:複数のブックから1つのシートに 11/8/25(木) 14:44 発言[未読]
【69738】追記 11/8/25(木) 15:07 発言[未読]
【69744】Re:追記 UO3 11/8/25(木) 19:35 発言[未読]
【69752】Re:追記 11/8/26(金) 9:21 お礼[未読]

【69705】複数のブックから1つのシートに
質問    - 11/8/23(火) 12:06 -

引用なし
パスワード
   VBA初心者で申し訳ないのですが、複数のブックのある指定範囲から1つのシートに並べていくのに、とあるサイトから下記コードでやってみたところ、コピーは上手くできました。

ただ、実行するたびにどんどん下に追加されていきます。
もしセルの内容が同じだった場合、それは追加されず新規内容のみ追加されるようにするにはどのようにすればよろしいのでしょうか?

説明が下手で申し訳ないのですが、宜しくお願いします。

Sub 複数のファイルを一つに()
Dim theName As String 'ブック名の保存用
Dim theDir As String 'パスの保存用
Dim theBook As Workbook '開いたブックの保存用
Dim flg As Boolean '1件目かどうかの識別用

flg = True
Application.ScreenUpdating = False

'現在のカレントパスのtenkiフォルダに移動する
theDir = ThisWorkbook.Path & "\tenki"
'(1) 拡張子xlsのファイル名を取り出す
theName = Dir(theDir & "\*.xls")

'(2) 最後のファイル名を取り出すまで繰り返す
Do While theName <> ""
'取り出したファイル名を指定してオープン
Set theBook = Workbooks.Open(theDir & "\" & theName)
'サブプロシージャへ
Call subTenki(theBook, flg)
flg = False
theBook.Close
theName = Dir
Loop
End Sub


'---開いたブックのアクティブセル領域をコピーする(サブプロシージャ)

Sub subTenki(theBook As Workbook, flg As Boolean)
Dim thetbl As Range, LRow As Long

Set thetbl = theBook.Sheets(1).Range("A3:B6")
'コピーする
thetbl.Copy

With ThisWorkbook.ActiveSheet
'(3) 転記先のシートのどの行までデータが入っているかを調べる
LRow = .Range("A65536").End(xlUp).Row

If LRow = 1 Then
.Range("A" & LRow).PasteSpecial xlPasteValues
Else
.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End If
End With
Application.CutCopyMode = False
End Sub

【69706】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/23(火) 12:25 -

引用なし
パスワード
   ▼熊 さん:

こんにちは

>もしセルの内容が同じだった場合

転記対象のセルは転記元の A3:B6 ですから、セルの数として8セル。
行数でいうと、4行ですね。

「セルの内容が同じ」という定義は、

1.この8セルがすべて同じ。
2.転記する行(2セル)が同じ
3.A列(あるいはB列)がキー項目で、そのキー項目としての1つのセルが同じ。

このいずれでしょうか?
で、いずれの場合であっても、転記先の開始行が必要になりますが2行目ということで
よろしいですか?

【69707】Re:複数のブックから1つのシートに
発言    - 11/8/23(火) 13:22 -

引用なし
パスワード
   早速の返信ありがとうございます。
わかりにくい説明で申し訳ないです。

現在のA3:B6は動作確認で仮で入れております。
実際に使用するときはセルとしては20程度となり、Aの列とBの列では同じデータは存在しません。

例えば・・・
Book1のA3から順に「R290、R521、R532」B3から順に「新潟、愛知、福岡」となってBook2のA3から順に「R230、R551、R632」B3から順に「佐賀、福井、東京」となって
おり、先のマクロを実行すると、A1から順に上記データが並んできます。
この時に、もう一度マクロを実行すると、その下からさらに同じデータが並んできます。

2回目に実行した際に
Book1のA3から順に「R290、R521、R532、R670」B3から順に「新潟、愛知、福岡、大阪」となって、Book2のA3から順に「R230、R551、R632」B3から順に「佐賀、福井、東京」となった場合、同じ部分は更新されずに、A行にR670、B行に大阪という項目のみ更新するようにしたいです。

転記先の開始行ですが、先のコードを自分なりにいじってみたのですが、
.Range("A" & LRow).PasteSpecial xlPasteValues
の部分で指定できそうなのですが私の認識が間違っているでしょうか?

【69709】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/23(火) 15:03 -

引用なし
パスワード
   ▼熊 さん:

説明ありがとうございます。
Book1とBook2の、どちらが転記元で、どちらが転記先か、ちょっとややこしい説明でしたが?

いずれにしても「行」単位にユニークなものだけを転記するということはわかりました。
で、たとえば転記元のA列に■■■、B列に○○○があったとして、それを転記先にあるかどうかの
判断を行うに当たり、

1.転記先のA列に■■■があれば「重複」とみなす?
2.転記先のB列に○○○があれば「重複」とみなす?
3.転記先のA列が■■■で、「かつ」B列が○○○のものがあれば「重複」とみなす。

このいずれですか?(たぶん、3?)

>.Range("A" & LRow).PasteSpecial xlPasteValues
>の部分で指定できそうなのですが私の認識が間違っているでしょうか?

これについては、オリジナルのコードのどちらのことをおっしゃっているのかわからないので
なんともいえないのですが(というか、アップされたコードのままですよね)
いずれにしても「値の転記」ですから、私がご提案する場合は、Copy/Paste系の処理はしません。

【69710】Re:複数のブックから1つのシートに
発言    - 11/8/23(火) 15:59 -

引用なし
パスワード
   返信ありがとうございます。
何度も申し訳ございません。

まず、転記先のファイルは別にあります。
その転記先ファイルと同じフォルダ内に「tenki」フォルダがあります。
そのフォルダ内に「book1」「book2」があります。

各個人が扱うファイルはこの「book1」「book2」となります。
このファイル数は、10個程度でファイル名も各個人の名前にします。
そしてこのファイルの任意に指定した部分を1つの転記先ファイルにまとめたいです。どこのセルに入力するかも任意に設定したいです。(連続したセル)
この時、理解されている通り、ユニークなものだけを転記していきます。
という動作を行いたいと思っております。

このマクロの起動トリガはコントロールフォームのボタンやTファイル起動時にしたいと思っております。(これはまた別マクロになると思うので、この部分はまた別で調べようと思っております。)

おっしゃられる通り
3.転記先のA列が■■■で、「かつ」B列が○○○のものがあれば「重複」とみなす。
としたいです。

.Range("A" & LRow).PasteSpecial xlPasteValues
はこのままでと白紙のシートだと「A1」からの入力に成りますが、A行のどこかにデータがあればその下からデータが入ってきます。(A3に「番号」と入れておくとその下から転記されます)
.Range("B" & LRow+5).PasteSpecial xlPasteValues
とすれば、白紙のシートでも「B5」から入力されていきます。

・・・ということじゃないですかね?
素人で的外れなことを言っていましたら申し訳ないです。

ただ、上記にあるように転記先のセルは任意に設定したいと思っております。

【69711】Re:複数のブックから1つのシートに
回答  UO3  - 11/8/23(火) 15:59 -

引用なし
パスワード
   ▼熊 さん:

とりあえず、↑の解釈で。
以下で試してみてください。

Sub subTenki(theBook As Workbook)
  Dim thetbl As Range, LRow As Long
  Dim strA As Variant, strB As Variant
  Dim c As Range
  Dim cellA As String
  Dim cellB As String
  
  Set thetbl = theBook.Sheets(1).Range("A3:B6")
  
  With ThisWorkbook.ActiveSheet
    LRow = .Range("A" & .Rows.Count).End(xlUp).Row
    If LRow = 1 Then
      .Range("A2").Resize(thetbl.Rows.Count, thetbl.Columns.Count).Value = thetbl.Value
    Else
      cellA = .Range("A3:A" & LRow).Address
      cellB = .Range("B3:B" & LRow).Address
      LRow = LRow + 1
      For Each c In thetbl.Columns(1).Cells
        strA = c.Value
        strB = c.Offset(, 1).Value
        If Not Evaluate("=SUMPRODUCT((" & cellA & "=""" & strA & """)*(" & _
                          cellB & "=""" & strB & """))=1") Then
          .Cells(LRow, "A").Resize(, 2).Value = c.Resize(, 2).Value
          LRow = LRow + 1
        End If
      Next
    End If
  End With
 
End Sub

【69712】Re:複数のブックから1つのシートに
お礼    - 11/8/23(火) 17:26 -

引用なし
パスワード
   ありがとうございます。

下記のコードでやってみたのですが、book2の方のデータが引用されていませんでした。
とりあえずこちらのコードを元に色々と試行錯誤してみます。

【69713】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/23(火) 17:30 -

引用なし
パスワード
   ▼熊 さん:

こんにちは

>まず、転記先のファイルは別にあります。

転記元(取り出されるブック)と転記先(書き込まれるブック)が別だというのはコードを
読んでわかっています。
ただ、コードでは転記先がTHisWorkbook、つまり、このマクロブックになっていますね。
これ、具合が悪いですね? 
(すでにアップしたコードは、マクロブックに書き込もうとしています)

>そしてこのファイルの任意に指定した部分を1つの転記先ファイルにまとめたいです。
>どこのセルに入力するかも任意に設定したいです。(連続したセル)

>ただ、上記にあるように転記先のセルは任意に設定したいと思っております。

取り出す位置の「任意」というのは、マクロ実行時に、外から(操作者に指定させるとか)与えるという意味で「任意」なのですか?
それとも、プログラムの中で、実行時に、コードをなおして、場所を変えたいということですか?
また、書き込む位置の「任意」は、本当に「任意」なんですか? そうじゃなく、書き込む場所を自動判定したいということでしょ?

>3.転記先のA列が■■■で、「かつ」B列が○○○のものがあれば「重複」とみなす。
>としたいです。

了解です。ただ、「2列」というのは固定でいいですか?
アップしたコードは2列にしています。3列あるいは4列といったこともありうるなら、根本的に直す必要があります。

>このマクロの起動トリガはコントロールフォームのボタンやTファイル起動時にしたいと思っております。

これは、たやすいことですが、まず、ベースの部分を完成させましょう。


>・・・ということじゃないですかね?
>素人で的外れなことを言っていましたら申し訳ないです。

いやいや、まとはずれじゃないですよ。でも、あまり意味を持たないというか、
少なくとも、こちらは、そこを質問していません。

【69714】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/23(火) 17:42 -

引用なし
パスワード
   ▼熊 さん:

Book1、Book2を読み込んでいる部分は、Sub 複数のファイルを一つに() です。
私は、ここをさわっていません。
Book1が反映されてBook2が反映されないのが、私がアップした部分の処理の結果だとすれば
Book2が持つデータと同じデータが既に転記先に存在するということでは?

それより、連絡忘れましたが、私がアップした Sub subTenki(theBook As Workbook) では
引数の flg を削除しています。(使っていなかったので)

一方、Sub 複数のファイルを一つに() からの Call には flg が残ったままだと思いますので
実行するとエラーになったはずなんですが?


いずれにしても、質問している件への回答・確認、よろしくお願いします。

【69715】Re:複数のブックから1つのシートに
発言    - 11/8/23(火) 17:53 -

引用なし
パスワード
   ▼UO3 さん:

返信ありがとうございます。

>ただ、コードでは転記先がTHisWorkbook、つまり、このマクロブックになっていますね。
>これ、具合が悪いですね? 
>(すでにアップしたコードは、マクロブックに書き込もうとしています)

マクロブックに書き込んで問題ないです。

マクロブック--------------book1
           |____book2
           |____book3
           |____ :

階層的に言ったらこんな感じですかね?
集計するのはマクロブックであって問題はありません。


>取り出す位置の「任意」というのは、マクロ実行時に、外から(操作者に指定させるとか)与えるという意味で「任意」なのですか?
>それとも、プログラムの中で、実行時に、コードをなおして、場所を変えたいということですか?

たびたび説明不足で申し訳ないです。
プログラム上で任意と言う意味です。

>また、書き込む位置の「任意」は、本当に「任意」なんですか? そうじゃなく、書き込む場所を自動判定したいということでしょ?

ご指摘どうり書込む初めの位置はプログラム上で設定して、そこから連なるデータは自動的に下に追加される形です。


>了解です。ただ、「2列」というのは固定でいいですか?
>アップしたコードは2列にしています。3列あるいは4列といったこともありうるなら、根本的に直す必要があります。

ありがとうございます。現段階では2列で問題ありません。

【69716】Re:複数のブックから1つのシートに
発言    - 11/8/23(火) 18:44 -

引用なし
パスワード
   ▼UO3 さん:

返信を急いでしまい、複数にわたって回答してしまい申し訳ございません。

>Book1、Book2を読み込んでいる部分は、Sub 複数のファイルを一つに() です。
>私は、ここをさわっていません。
>Book1が反映されてBook2が反映されないのが、私がアップした部分の処理の結果だとすれば
>Book2が持つデータと同じデータが既に転記先に存在するということでは?

UO3さんのコードをサブプロシージャに入力して、実行してみました。
Book1とBook2のデータは違うものを入力しております。
まっさらなマクロブックで実行しますと、ちょっとと分かりにくいかもですが、A行のみで話をしますね。
B行も同じ結果になっていますので。
1.book1のA3〜A6まで、book2のA3〜A6までデータを入れた場合、(もちろん全て違う値)マクロブックのA2〜A6までデータが入ります。
この時A2〜A5まではbook1の値が入ります。
A6のみBook2のA6の値が入ります。
2.book1のA3〜A4まで、book2のA3〜B6までデータを入れた場合、(もちろん全て違う値)マクロブックのA2〜A6までデータが入ります。
この時A2〜A3まではbook1の値が入ります。
A4〜A6まではBook2のA4〜A6の値が入ります。

>それより、連絡忘れましたが、私がアップした Sub subTenki(theBook As Workbook) では
>引数の flg を削除しています。(使っていなかったので)
>一方、Sub 複数のファイルを一つに() からの Call には flg が残ったままだと思いますので
>実行するとエラーになったはずなんですが?

ご指摘どうり、エラーが発生しました。
ですので、Sub 複数のファイルを一つに()のCallのflgを削除しましたけど・・・これでコンパイルエラーおきなかったので勝手にこれでよし。と判断してしまいました。問題ないですよね? 

>いずれにしても、質問している件への回答・確認、よろしくお願いします。

何度も付き合って頂き本当にありがとうございます。
以降の返信は明日させていただきます。

【69725】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/24(水) 16:19 -

引用なし
パスワード
   ▼熊 さん:

詳細な連絡、ありがとうございます。

不思議ですねぇ。

こちらで BookAとBookBを作成。それぞれのA3:A6に異なるものをいれて、テストなので
開いたままにして、以下のテストを行いましたが、マクロブックのシートには、正しく
A2からB9まで8行のデータが転記されました。

2列の組合せで重複しているかどうかの判定をワークシート関数のSUMPRODUCTを使っています。
もし、にっちもさっちもいかなかったら、このSUMPRODUCTによる判定を、別方式に変えることは
できるのですが・・・・

Sub Test()
  Call subTenki(Workbooks("BookA.xls"))
  Call subTenki(Workbooks("BookB.xls"))
End Sub

【69726】Re:複数のブックから1つのシートに
発言    - 11/8/24(水) 17:36 -

引用なし
パスワード
   ▼UO3 さん:

返信ありがとうございます。

こちらでも
>Sub Test()
>  Call subTenki(Workbooks("BookA.xls"))
>  Call subTenki(Workbooks("BookB.xls"))
>End Sub
確認をしてみました。

そうすると、1回目の実行時、A2〜A9まで正常に入力されました。
そのまま2回目を実行すると、なぜかbookAのA2、B2セルのみマクロブックのA10、B10に追加されました。
そのまま3回目の実行を行うと、変化はありませんでした。

この問題はまた別問題と考えて、先に私がおこなった、サブプロシージャのみ変更した時の動作よりもきちんと動いています。

これを考えると、元の Sub 複数のファイルを一つに() の部分をどこか変更しないといけないのではないか?と考えて本日色々とやっていたのですが、どうもうまくいきませんでした。

何度もお手数をおかけして申し訳ないですがご教授願えないでしょうか。

【69733】Re:複数のブックから1つのシートに
回答  UO3  - 11/8/25(木) 10:48 -

引用なし
パスワード
   ▼熊 さん:

おはようございます

Sub 複数のファイルを一つに() でうまくいかないのは後回しにして
Test を使ったケース、ご連絡いただいた状態がこちらでも再現しました。
ごめんなさい。コードミスです。

cellA = .Range("A3:A" & LRow).Address
cellB = .Range("B3:B" & LRow).Address

これを

cellA = .Range("A2:A" & LRow).Address
cellB = .Range("B2:B" & LRow).Address

に変更願います。

【69734】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/25(木) 10:56 -

引用なし
パスワード
   ▼熊 さん:

で、続報です。

マクロブックがあるフォルダに"tenki"フォルダを作成して
テストで使っていたBookA.xlsとBookB.xlsをそこに移して、
「複数のファイルを一つに」を、そのまま実行。(Call 時のflg引数は削除しました)

結果は、最初の実行も正常ですし、その後、何度やっても、データが追加されることは
ありませんでした。

【69735】Re:複数のブックから1つのシートに
発言    - 11/8/25(木) 11:06 -

引用なし
パスワード
   ▼UO3 さん:

返信ありがとうございます。

変更後、正常に動きました。
ありがとうございます。

ただ、やはり
Sub 複数のファイルを一つに()
を使用すると、動作がおかしいです。

もう少し私なりに考えてみます。

【69736】Re:複数のブックから1つのシートに
発言  UO3  - 11/8/25(木) 13:14 -

引用なし
パスワード
   ▼熊 さん:

もしかして、「このブックを扱っているはずだ」と思っているブックが、
tenki とは別のブックにあって、tenkiにあるブックには、それとは異なるデータがあったり?

【69737】Re:複数のブックから1つのシートに
発言    - 11/8/25(木) 14:44 -

引用なし
パスワード
   ▼UO3 さん:

返信ありがとうございます。

>マクロブックがあるフォルダに"tenki"フォルダを作成して
>テストで使っていたBookA.xlsとBookB.xlsをそこに移して、
>「複数のファイルを一つに」を、そのまま実行。(Call 時のflg引数は削除しました)
>
>結果は、最初の実行も正常ですし、その後、何度やっても、データが追加されることは
>ありませんでした。

問題なく動作したということですね。。。


またかなり不可解なことがおきているので、説明させていただきます。

まず1度全ての箇所にブレークポイントを入れ1つずつ実行させ、1ステップ進むごとに、マクロブックを確認してどのようにデータが転記されているのかを確認してみました。
するとA2〜A5まではBookA,A6のみBookBのA6セルと先日と同じ症状がおきました。
次に、1ステップずつ進めて、その都度マクロブックをアクティブにしてみました。
すると、問題なく全て転記されました。(正常動作)

次に、ブレークポイントをサブプロシージャの頭
Sub subTenki(theBook As Workbook)
に入れ動作させました。
この時、転記元のBookA及びBookBがアクティブになるので、サブプロシージャが動く前に、1度マクロブックをアクティブにして確認しました。
すると、問題なく全て転記されました。(正常動作)
次に、同じようにブレークポイントは変えずに、マクロブックをアクティブにしないとまたおかしな転記になっていました。

まとめると、転記の動作の前に1度マクロブックをアクティブにしないと正常に転記が行えないような状態になっています。

こうなってしまうと、なにがなんだかわけがわかりません。。。
プログラムには問題なく、全く別の問題なのでしょうか?

ちなみに使用環境は、Office2007、WindowsXPを使用しています。

【69738】追記
発言    - 11/8/25(木) 15:07 -

引用なし
パスワード
   何度も申し訳ございません。

「転記の動作の前に1度マクロブックをアクティブにしないと正常に転記が行えないような状態になっています。」
ならアクティブにすればいい。と思い、

book1の変数作って
Call subTenki(theBook)の前に
Set book1 = Workbooks("テスト.xlsm")
book1.Activate
を入れたら正常に動きました。。

おそらくこれでいいのかな?と判断したのですが・・・

【69744】Re:追記
発言  UO3  - 11/8/25(木) 19:35 -

引用なし
パスワード
   ▼熊 さん:

よ〜く考えてみましたら、熊さんの手当が正しいようなきがしてきました。
Sumproductで評価しているのは、セルアドレスだけを指定していますから、
そのときのアクティブシートの評価になりますね。
なぜ、こちらでうまくいったのか、そのあたりはつめきっておらず気持ちが悪いのですが。

【69752】Re:追記
お礼    - 11/8/26(金) 9:21 -

引用なし
パスワード
   ▼UO3 さん:

>よ〜く考えてみましたら、熊さんの手当が正しいようなきがしてきました。
>Sumproductで評価しているのは、セルアドレスだけを指定していますから、
>そのときのアクティブシートの評価になりますね。
>なぜ、こちらでうまくいったのか、そのあたりはつめきっておらず気持ちが悪いのですが。

ただ、こちらの動作でも最終セルのみにBookBの最終データが飛んでくるというのがよくわからないですね。。
BookAのデータはアクティブにしないでも転記されてるし。。。

まぁ、いずれにしろとりあえず形上、上手く動いているので一旦これで続きを作成してみます。
また何か不具合が出てきましたら調べてみますね。

数日にわたり色々とご教授いただき本当にありがとうございました。
助かりました。
また、何かあったら相談させてもらいます。

2135 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free