[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAで複数ブックから転記集約』（usamiyu）
いつもみなさまに大変お世話になっております。また、ご相談させてください。
様式ブック並びに転記元ブックa及び転記元ブックｂが同一フォルダにあります。 様式ブックにマクロを書き、以下の手順で転記したいと考えています。 自分では、下記のコードを書いたのですが、A3行のみがずら〜っと転記され、失敗してしまいました。 どうかお知恵を貸していただけますか？
【手順】 １ 様式ブックを開いておく ２ 転記元ブックaを開く ３ 転記元ブックbを開く ４ 転記元ブックa(シートは1枚のみ）のA列に１を立てた行を様式ブックの3行目以降に転記 ５ 転記元ブックb(シートは1枚のみ）のA列に１を立てた行を４の次の行以降に転記 ６ 様式ブックをシート「CSVﾃﾞｰﾀ」のA2の名前をつけて、同じフォルダに保存 ７ 様式ブックのシート「選定資料」を印刷 ８ 様式ブックを閉じる ９ 転記元ブックaを上書き保存して閉じる 10 転記元ブックｂを上書き保存して閉じる
【レイアウト】 様式ブック（転記先のブック）※1行目と2行目は見出し行。3行目から転記。 __A__ __B__ __C__ __D__ __E_...__H___ ＿I___ __J__ __K__ __L__... __AN__ 1 番号 コード 名称 メモ 2 5501 30 機器 地域 3 A 2 - 0 123456 3333 大 334455 55.66 778899 4 A 4 - 25 123789 4444 小 445566 66.77 101010 5 B 30 - 0 123101 5555 中 555666 77.88 888999
転記元ブックa ※a,bともに項目名は同じ。aの転記が済んだら、その次の行からbの転記。 __A__ __B____ __C__ __D__ __E___ __F___ ...__S__ ... __AO__ 1 30 機器 2 A 1 - 0 123000 11.33 0 3 1 A 2 - 0 123456 55.66 0 4 A 3 - 0 123444 22.44 0 5 1 A 4 - 25 123789 66.77 0
【コード】
Sub select_data()
Dim wba As Workbook '転記元ブックa
Dim wbb As Workbook '転記元ブックb
Dim shfroma As Worksheet '転記元シートa
Dim shfromb As Worksheet '転記元シートb
Dim shtod As Worksheet '転記先シート
Dim sep As String
Dim filepatha As String
Dim filepathb As String
sep = Application.PathSeparator '\
'転記元ブック選択
filepatha = Application.GetOpenFilename("Excelファイル,*.xls*")
If filepatha = "False" Then Exit Sub
'転記元ブックを開く
Set wba = Workbooks.Open(filepatha)
Set shfroma = wba.Sheets(1)
Set shtod = ThisWorkbook.Sheets("CSVﾃﾞｰﾀ")
'転記元ブック選択
filepathb = Application.GetOpenFilename("Excelファイル,*.xls*")
If filepathb = "False" Then Exit Sub
'転記元ブックを開く
Set wbb = Workbooks.Open(filepathb)
Set shfromb = wbb.Sheets(1)
'転記処理
Call CopyList(shfroma, shtod)
Call CopyList(shfromb, shtod)
MsgBox "転記終了"
'このブックを同じフォルダにA2セルの名前で保存
With ThisWorkbook
.SaveAs ThisWorkbook.Path & sep & Sheets("CSVﾃﾞｰﾀ").Range("A2") & ".xls"
.Sheets("選定資料").PrintOut
.Close
End With
'転記元ブックa上書き保存
wba.Save
wba.Close
'転記元ブックb上書き保存
wbb.Save
wbb.Close
End Sub
Private Sub CopyList(shfrom As Worksheet, shto As Worksheet)
Dim myKey As Integer
Dim i As Integer
Dim lastrow As Integer
Dim z As Long
'転記範囲をクリア
shto.Range("A3", shto.Range("A" & shto.Rows.Count).End(xlUp)).Resize(, 40).ClearContents
' ? lastrow = shfrom.Range("B2", shfrom.Range("B" & shfrom.Rows.Count).End(xlUp)).Row
myKey = 1
For i = 3 To 20 'lastrowにするとエラーなのでとりあえず20行
If shto.Cells(i, "A") = "" Then
z = Application.WorksheetFunction.Match(myKey, shfrom.Range("A:A"), 0)
If IsNumeric(z) Then
shto.Cells(i, "A").Resize(, 39).Value = shfrom.Cells(z, 2).Resize(, 40).Value
End If
Else
i = i + 1 'i行目が空白でなかったら次の行に記載したい ???
End If
Next
End Sub
とりあえず、CopyListの方のコードを以下にしたらどうですか？
Private Sub CopyList(shfrom As Worksheet, shto As Worksheet)
Dim i As Integer
Dim lastrow As Integer
lastrow = shfrom.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow
If shfrom.Range("A" & i).Value = 1 Then
shfrom.Cells(i, 2).Resize(, 40).Copy shto.Cells(shto.Range("A" & Rows.Count).End(xlUp).Row + 1, "A")
End If
Next
End Sub
で、クリアする一行（shto.Range("A3", shto.Range("A" & shto.Rows.Count).End(xlUp)).Resize(, 40).ClearContents ）
は最初の一度にしないと、aの転記後にまたクリアされてしまいますよね？
このコードは元のプロシージャの初めのほうに入れておくべきでしょうね。
(Jera)
衝突しちゃいましたが。。。。
＞A3行のみがずら〜っと転記され、失敗してしまいました。
の考え方ですが。。
「１」になっている行を探す所が、今は
z = Application.WorksheetFunction.Match(myKey, shfrom.Range("A:A"), 0)
If IsNumeric(z) Then
shto.Cells(i, "A").Resize(, 39).Value = shfrom.Cells(z, 2).Resize(, 40).Value
End If
ってなってますよね。（実際は上側だけですが。）
簡単に考えてみると Z=MATCH(1,A:A,0)と言う式です。 MATCH関数は「最初に見つかった位置」を返してくれるので A3セルに「1」があったら 何度計算しても「3番目にあるよ〜〜」って言ってきます。
単純に考えると、上から順に 1かどうか を確認すれば良いと思いますよ？
For i = 2 To データがある最後の行まで ・・・・1行目が見出しで、データは2行目からですよね。 If 転記元ブック.Cells(i, "A").Value = 1 Then ・・・・転記元ブックの Ａ●セルの値が「1」だったら 転記先ブックの該当行 = 転記元ブックのi行目のセルを転記 End If Next
この時、転記元ブックの該当行 と言うのは iに連動するのではなく If 〜 Then の方に分岐した時に 一つずつ数が増えていくので 新しい変数を作るのが良いと思います。
たぶん、こんな感じで。。。
'------
Private Sub CopyList(shfrom As Worksheet, shto As Worksheet)
Dim myKey As Integer
Dim i As Integer
Dim lastrow As Integer
Dim 転記先行 As Long
転記先行 = shto.Range("A" & shto.Rows.Count).End(xlUp).Row
lastrow = shfrom.Range("B" & shfrom.Rows.Count).End(xlUp).Row
myKey = 1
For i = 2 To lastrow
If shfrom.Cells(i, "A").Value = myKey Then
転記先行 = 転記先行 + 1
shto.Cells(転記先行, "A").Resize(, 39).Value = shfrom.Cells(i, 2).Resize(, 40).Value
End If
Next
End Sub
'------
動くんじゃないかと思いますが、どうでしょう？
(HANA)
回答書いている間に同じような回答がついていたのでコメントだけですが、 転記の Resize は同じ大きさにしておいたほうが良い気がしました。 (Mook)
衝突時に転記漏れがありましたので、追記です。 Jeraさんと重複する部分もありますが。
転記先行が次の行に移るのは 転記する（転記した）時です。 それから、転記先のデータを消すのは 二つのブックの転記処理を始める前です。 CopyList の中で削除すると 二つ目のブックを処理する時もデータを削除してしまうので せっかく転記した一つ目のブックのデータが消えてしまう事になります。
(HANA)
(Jera)さん、(HANA)さん、(Mook)さん ご指導ありがとうございます。 ご丁寧に教えていただいて感激しています。 クリアする一行を最初のプロシージャに入れる件、もっともです。考えが足りませんでした。 MATCH関数はの件もなるほどです。よく理解していなかったです。
それで、以下のようにしてみたのですが、次の件が未解決になっています。引き続き教えていただけますか。 お手数をおかけしています。
１ クリアする一行を最初のプロシージャに入れました。 3行目以下をクリアしているつもりで記載したのが、2行目以下がクリアになってしまいます。 Set shfromb = wbb.Sheets(1)
Application.ScreenUpdating = False '画面描画停止 ★追加
'転記範囲をクリア ↓3行目以下をクリアしているつもりが2行目以下がクリアになる？ ★ここに移動
shtod.Range("A3", shtod.Range("A" & shtod.Rows.Count).End(xlUp)).Resize(, 40).ClearContents
'転記処理
Call CopyList(shfroma, shtod)
Call CopyList(shfromb, shtod)
２ サブルーチンは(HANA)さんのを参考にして次のように書くと、転記元ブックbの該当行がすでにaが転記
されている様式ブックの1行目から上書きされます。うーん、どう変更するといいでしょうか。
Private Sub CopyList(shfrom As Worksheet, shto As Worksheet)
Dim myKey As Integer
Dim i As Integer
Dim lastrow As Integer
Dim myrowto As Long
lastrow = shfrom.Range("B" & shfrom.Rows.Count).End(xlUp).Row
myKey = 1
myrowto = 2
For i = 2 To lastrow
If shfrom.Cells(i, "A").Value = myKey Then
myrowto = myrowto + 1
shto.Cells(myrowto, "A").Resize(, 40).Value = shfrom.Cells(i, 2).Resize(, 40).Value
End If
Next
End Sub
３ 同じくサブルーチンで(Jera)さんのを記載すると期待どおり記載されました。
1点だけ教えて下さい。様式ブックの3行以降に記載したいのですが、2行目以降に記載されます。
これは、クリアの件で、2行目の見出もクリアされたから、
shto.Cells(shto.Range("A" & Rows.Count).End(xlUp).Row が
1行目と数えられて、2行目以降に記載されてしまうのでしょうか？
４ (Mook)さん >転記の Resize は同じ大きさにしておいたほうが良い 理由はわからないながら同じにしてみました。当初、転記先はA列から、転記元はB列から記載だったので、 １つずらしましたが、そうすると何かトラブルが起こりがちですか？
(usamiyu)
ご質問１と３について。
>これは、クリアの件で、2行目の見出もクリアされたから、
>shto.Cells(shto.Range("A" & Rows.Count).End(xlUp).Row が
>1行目と数えられて、2行目以降に記載されてしまうのでしょうか？
そうです。マクロブックのA3セル以降に何もデータがない場合、１にあるコードを
shtod.Range("A" & shtod.Rows.Count).End(xlUp).selectにしてみるとA2セルを選択しますよね？
つまりshtod.Range("A3", "A2").Resize(, 40).ClearContentsと同じ事になってしまいます。
とりあえず
shtod.Range("A3:A" & shtod.Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(, 40).ClearContents
としたらどうでしょうか？
一文が長いので、shtodをwithステートメントで括ったり最終行を変数に入れても良いかもしれません。
(Jera)
というか、見出し行以外を全てクリアするだけなら厳密に最終行を求めなくても
shtod.Range("A3:IV" & rows.count).ClearContentsで良いかもしれませんね。
最終列が分からないのでIVとしていますが、少なくともresizeは特に必要ないと思います。
それと最初のレスで勢い余ってmykeyを削除し
If shfrom.Range("A" & i).Value = 1 Then
と決め打ちしてしまいましたが、変動の可能性があるならこの変数は残したほうがいいですね。失礼しました。
(Jera)
ご質問２に関してですが
私がもともと書いていた
＞転記先行 = shto.Range("A" & shto.Rows.Count).End(xlUp).Row
これの必要性を考えてみて下さい。
新しく作成されたコードでは ＞myrowto = 2 になっている部分の事です。
これだと、CopyListを実行するたびに 3行目から転記されますね。
１回目の CopyListを実行して、いくつかデータが転記された状態から ２回目の CopyListを実行する前の 転記先シートの状態をイメージして下さい。
２回目の最初に「1」になっていたデータは 何行目に転記されるべきでしょう？
myrowto = 2 → myrowto = myrowto + 1 ・・・・3行目 ではなく 1回目の転記が終わった時点での最終行 + 1 の行ですよね？
(HANA)
(jera)さん
shtod.Range("A3:IV" & rows.count).ClearContentsで解決しました。すっきりです。
本当にありがとうございました。
(HANA)さん
わーっ！！大変失礼いたしました。なんでか
＞転記先行 = shto.Range("A" & shto.Rows.Count).End(xlUp).Row
これを見逃していて、あとから勝手に自分でmyrowto = 2なんて入れちゃってました。（冷汗！）
コメントいただく前にお詫びしたかったんですが、間に合わなくて申し訳ありません。
でもやっぱり基本的に理解してなかったからですね。ご指導ありがとうございました。
(usamiyu)
あ、ご自身で気づいておられましたか？ なんとなくうまくいくコードが出来るより うまくいかないコードを、動くものに修正した方が 色々な事が頭に入りやすいと思っています。
もう少しゆっくり書き込みすれば良かったですね。＾＾；
以下、動きには関係ないのですが 私としては
セルを表すのに
Range("A" & shtod.Rows.Count) Cells(i, "A") Cells(z, 2)
と、色々な書き方に成っています。
なるべく同じ様な書き方がして有るのが好みです。
また、コードの最初の方で （１）１つ目の転記元ブックを選択し開き、shfroma にセットする （２）shtod に 転記先シートをセットする （３）２つ目の転記元ブックを選択し開き、shfromb にセットする の順番で処理されていますが、（１）と（３）と言うとても似たコードの間に 異質な（２）が入っていて、座りが悪い様に思います。
ブックを選ぶ処理が両方された後（途中で、Exit Subしなかった時）に 初めて（２）の処理をする価値が出てくるのではないかと思いますが。
それから、このコードは ThisWorkbookに書いてありますよね。 「.Close」の後ろにいくつかコードが有りますが、これらは実行されていますか？
(HANA)
(HANA)さん 遅い時間にまで、更なるご指導ありがとうございます。 私は安心して寝ちゃってました^^; 確認が遅くなりました。すみません。
1 セルの表現について rangeとcells 確かにごちゃまぜに使ってます。私的にはrangeに親しみがあって、好みなのですが、ループに 使えないので、こういった場合はcellsに統一するほうがベターなのでしょうか？
２ 最初のプロシージャの順番について そうですねぇ。おっしゃるとおり、順番が変ですね。 この順番になったのは、手作業でコピーしていたときにブックaを開き、コピーし、次にブックbを開き・・という 流れだったので、そのままにしていました。 でもコードだとブックaの時点でExit Subとなるとしっくりこないですね。入れ替えました。
３ 「.Close」について うわぁ！そうですね。マクロブックを閉じちゃってからだとその後のコードは実行されませんよね！！ ありがとうございます！ ということで、以下のとおり入れ替えてうまくいきました。
MsgBox "転記終了"
'転記元ブックa上書き保存
wba.Save
wba.Close
'転記元ブックb上書き保存
wbb.Save
wbb.Close
Application.ScreenUpdating = True '画面描画再開
'このブックを同じフォルダにA2セルの名前で保存
With ThisWorkbook
.SaveAs ThisWorkbook.Path & sep & Sheets("CSVﾃﾞｰﾀ").Range("A2") & ".xls"
' .Sheets("選定資料").PrintOut
.Close
End With
(usamiyu)
> １つずらしましたが、そうすると何かトラブルが起こりがちですか？ に対する回答ですけれど、
仕様を把握したうえでの、意図しての操作であるならよいのですが、 40のデータを39の場所に入れるのですから、データは欠落しますよね？ 先頭の39が入るというのが仕様だとは思いますが、ケースによってはこのような推測と 実際の動作が異って思い通りにならないことも出てきます。
ですから、あえて不確定な可能性を残さない方が良いのでは、という老婆心的なコメント でしたので、今回のこのためにトラブルが起こりがちということは特にないと思います。 (Mook)
すでにみなさんからの適切なアドバイスが出ているので、出る幕ではないけど、蛇足で。
>rangeとcells 確かにごちゃまぜに使ってます。私的にはrangeに親しみがあって、好みなのですが、ループに >使えないので、こういった場合はcellsに統一するほうがベターなのでしょうか？
確かに、統一した方が、見た目、きりっとしまったコードになると思うけど、自分の書いてきたコードを 翻ってみると、実にばらばらだね。反省。ただ、usamiyuさんのコメントのように、どうしてもCellsでないと 表現できないところもあるね。
たとえば
Cells(3,Columns.Count).End(xlToLeft) なんてコードの場合。 これが１行登場するから、すべてのコードを Cells記述しなきゃいけないというのも、ちょっとつらいね。
確かにループの時には Cellsのほうが使いやすいと言うこともあるし。
ただ、行方向のループであれば、Range でもできるよ。 Range("A" & i) といったように。
(ぶらっと)
もしかしたら、デバッグの仕方をご存じないかな、と思いました。
デバッグの手順は
1) コードの動きを思い浮かべる。できるだけ詳細に思い浮かべる。
2) 実際にコードを動かしてみる。できるだけ少しずつ動かしてみる。
自信のある部分は、さらっと流してもOK
3) 1と2で違っている部分を見つける。
4) その原因を考え、見つけ、対策を講じる。
※数をやっていると、コードを見ただけで実際に動かさなくても 3)ができるようになります。
VBEにはデバッグのための道具（デバッガと言います）が準備されています。
ネットで検索すれば、画像付きの説明サイトが見つかりますので、ご確認ください。
−佳−
私も Range 表記がなじみ深くて好きです。
ぶらっとさんが書いておられますが、今回は列方向のループが無いので Range表記だけで出来ると思いますよ。
たとえば
Range("A" & shtod.Rows.Count)
この部分が／~~~~~~~~~~~~~~~~
myrowto になったり、i になったりするだけですよね？
一つの中で統一する事より、その時に考えやすい物を使えば良いと思います。 もしも↓の行が shto.Cells(i, "A").Resize(, 39).Value = shfrom.Cells(z, 2).Resize(, 40).Value
右側と左側で同じ様に書いてあれば shto.Cells(i, "A").Resize(, 39).Value = shfrom.Cells(z, "B").Resize(, 40).Value shto.Cells(i, 1).Resize(, 39).Value = shfrom.Cells(z, 2).Resize(, 40).Value
他の所で Range("A" & shtod.Rows.Count) と書いてあっても
取り立てて書きはしなかったと思います。
たとえば、Range(セル1,セル2)と言う書き方は、Rangeを使わないと出来ませんし 列方向へのループは Cellsを使う方が便利だと思いますので。
そういえば
＞lastrow = shfrom.Range("B2", shfrom.Range("B" & shfrom.Rows.Count).End(xlUp)).Row
だとエラーになった理由は分かりましたか？
・・・ちょっと、何のエラーに成っていたのか分からないですが。
佳さんが書いておられるデバッグ技術を 是非身につけて 探ってみてもらえると良いと思います。
(HANA)
(Mook)さん コメントありがとうございました。せっかくの機会なので理由を教えていただきたくて、確認しました。 いつも、ご指導、フォローしていただき、心から感謝しております。
(ぶらっと)さん 今回自分で書いたコードは前回ご指導いただいたcall子プロシージャ（引数、引数）という形を
使ってみました。これって便利ですねぇ。matchに関しては私の理解が足らず、使い方を間違えましたが。^^;
また、Range("A" & i) のアドバイスもありがとうございました。次の機会にもぜひご指導してくださいね！
−佳−さん コメントありがとうございます。デバックの仕方を知ること、大事だと思っています。 今のところ私はステップ実行とローカルウィンドウで変数の値を見るということをなんとなくやっています。でも今回は サブルーチンで間違いがずらっと転記された時点でちょっと気落ちしまして、すぐに質問しちゃってました。反省。 デバックでは、あと、イミディエイト、ウオッチの各ウィンドウの使い方を覚えたいのですが、うまく使えていません。もう少し使い方を調べます。 イミディエイトにはよく「オブジェクトがない」とか「プロパティ、メンバがサポートされていない」とか怒られて、 ？？という状態になっています。 あとステップ実行でエラーを出したとき、エラーの意味がなかなかわからないのが、難しいですね。
(HANA)さん コメントありがとうございます。
＞一つの中で統一する事より、その時に考えやすい物を使えば良いと思います。
了解です。
＞lastrow = shfrom.Range("B2", shfrom.Range("B" & shfrom.Rows.Count).End(xlUp)).Row
＞だとエラーになった理由は分かりましたか？
これが今、元のコードを貼り付けて、F8してみると、なぜかエラーになりません・・(ーー;)
あとで分析できるようにその場でエラーメッセージを書きとめておかなきゃだめだったですね。
今回、反省点が多くて勉強になりました。
(usamiyu)
ちょっと繰り返しになるのですが、デバッガというのはあくまでも道具であって
デバッグするのはusamiyuさん自身です。
こういう部分をチェックしたい→そのためにはどうしたらいいだろう→いろいろ
方法はあるがデバッガのこの機能が便利だ。となるのが本来の流れです。
デバッガのこの機能を使いこなそう、から始まるのはちょっとへんな感じがします。
（あらかじめ道具の使い方を覚えておくのは悪くないと思いますが）
自分の場合、イミディエイトウィンドウは基本的にメッセージボックスの代わりです。
それ以外に使うことはほとんどありません。
イミディエイトウィンドウに怒られるのは、ちょっと状況が浮かびませんね。
ローカルウィンドウは、配列の中身を見たり（一覧表示できるので便利）
オブジェクトの中身を見たり（一覧表示できるので。こちらはむしろコード作成時に
重宝しています）。
ウォッチウィンドウは使いません。いまのところ必要性を感じないので。
■あとステップ実行でエラーを出したとき、エラーの意味がなかなかわからないのが、難しいですね。
まあこれも数をこなせば、という部分はありますが ^^;
エラーの中身は、おおまかに言って「ありません」「知りません」「できません」です。
３つのうちどれかなと考えると、すこしは解決しやすいかも知れません。
あと、左辺 = 右辺 でエラーがでている場合は 仮の変数 = 右辺 とか
左辺 = 仮の値 とかしてみると切り分けしやすくなります。
なんとなく、デバッガ→エラーメッセージ という発想になっていますが
エラーメッセージのでるエラーは、とっかかりがあるだけまだ簡単かも知れません。
エラーメッセージのでないエラーでは、このコードはこのように動くはずという
イメージが重要になります。
■サブルーチンで間違いがずらっと転記された時点でちょっと気落ちしまして、
いそぎの仕事でなければ、コードは一日くらい放置しても構わないんですよね。
一日もあれば、気力も回復しますよ。
いや、こういうのも、コードを書くための「技術」かな、と思います。
−佳−
−佳−さん >デバッグするのはusamiyuさん自身です。 はい。そうですね。自分で考えないとだめですね。改めて考えてみます。
＞エラーメッセージのでないエラー そうですか。ですよね。考えてみたことなかったですが、エラーメッセージが教えてくれるだけ、 まだ、ましでしたねぇ。毎日、エラーを出しているのでありがたさに気づかなかったかも。 「数をこなせば」というお言葉を信じて、試行錯誤してみます。
また、最後のお言葉も、お気遣いいただき、ありがとうございました。 落ち込むときもありますが、基本的にはコード（って言えるレベルでもないですが(^^ゞ）を書くのは 楽しいです！これからも楽しみながら進歩していけたらいいなって思っています。
(usamiyu)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.