VBA教えてください。（表の作成）

質問

いつもお世話になっております。
非常に手間となっている作業があり、VBAにしたら楽だろうと思うのですが、自分では作成できずにいます。複雑な内容になるのですが、教えていただける方、お願い致します。

Sheet1に表があり、Sheet2に必要事項のみを抜き出した表を作成したいです。

Sheet1は、横一行が1製品分の情報で、それが、数百行あります。2行目が項目名です。
V列が製品種類、W列が製品名、AV列に番号があります。番号は数字のときも、カナのときもあります。

Sheet2は、V列（製品種類）、W列（製品名）で分類した表になっていて、AV列（番号）を列記したいです。
一枚に印刷したいため、入り組んだ表になります。
この表は、内容が追加されたりと、流動性があるため、それに対応できるようにもしたいと考えています。

今考えていたのは、
Sheet2の右のスペースに、表にするための情報入力するスペースを作り、
Q（通称、Sheet1の表にはない、特に意味はないです）、R（製品種類）、S（製品名）、T（Sheet2の入力箇所を指定）
RとSの内容でsheet1のオートフィルタ、
Sheet1のAV列（番号）をコピーして、sheet2のTで指定したところに貼り付ける。
それを上から順に繰り返す。というものです。

※1　RとS→Sheet1のAV（番号）をT（入力箇所）に格納ですが、T（入力箇所）に入るRとSは1つとは限らず、2、3種類あるものもあります。
※2　同じT（入力箇所）のなかで、AV（番号）が重複する場合もあり、その際は、1回のみ入力したいです。
　→例えば、R（ノート）＆S（A社用）（T（N6）に入力）でAVが7000、R（ノート）＆S（A社用）（T（N6）に入力）でAVが7000　この場合は7000、7000ではなく、7000にしたいです。

さらに、これを1日数回行います。
Sheet1の情報は、1日の中で下に追加されていき、削除されることも、順番が入れ替わることもありません。1日分の情報をまとめて1枚にしたいです。あとから同じ番号が出てくることもありません。
また、どこから追加されたのかが分かるようにもしたいのです。分かるようにというのは、太い罫線が入ってもいいですし、書体が変わってもいいですし、色が変わってもいいです。
例えば、1回目作成した際に（イ、エ1、ナ、タ1、タ2）のとき、2回目は（イ、エ1、ナ、タ1、タ2//ナ1、ミ、ヤ）というような感じです。3回目があっても追加です。
前回の内容は残す必要はなく、1日のなかで上書きで大丈夫です。日が変わると、Sheet1も一度空になり、その際にSheet2のデータもクリアにしますが、それは自分で作成できそうです。

どうぞよろしくお願い致します。

回答No.3

kon555 · ベストアンサー

>>方向性はいかがでしょうか
　いいと思います。貴方が自分の業務改善の範囲で留めるなら、貴方が使いやすければそれが正義です。そしてVBAの仕様的に無理なく実装できる機能ですから、何も問題ありません。

　例えばこれが部署レベルでの業務システムの構築であるとか、もっと大規模なデータを処理するとか、0.1秒でも早く処理したいとなれば「ああすべき」「これはダメ」といったセオリー的な物もあります。
　しかし作成者一個人が使用するという前提なら、何をおいても『動いて使えれば100点満点』ぐらいの気分で作ればいいのです。

　現時点でアドバイスするとしたら、以下のようなものですね。
1.「どんな風に使うか」を、軽いメモ書きや覚書レベルでいいので残した方がいい
2.コード１行のなかで「'」を入力した以降はコメントとして機能的には無意味になるので、これを活用して「ここはどんな処理をしているか」を残した方がいい
3.もし先々マクロを書き換えたり改良する際は、古い(問題なく動く)バージョンはコピーしてバックアップしておく。

　業務というものには波があるので、今現在は毎日のようにやっている業務も、パタっと数か月来なくなる、みたいなパターンは多々あります。
　そうした時に、意外と人は忘れっぽいので、いざ再開しようとすると「ハテこのマクロはどんな手順で使うんだったかな・・・？」「自分で組んだこのコード、修正しようとしてもどこで何してるか完全に思い出せん・・・」となり、「ええいイチから組みなおす！」となります。
　これを経験していないエクセルVBAユーザーはいない、と言い切っていいくらいのあるあるネタです。
　なのでそうした事態に今のうちに備えて、使い方や処理の内容を軽く残しておくと数か月後とか、数年後に凄く助かる事になります。

お礼

ありがとうございます。罫線で目印をつけるマクロ、完成しました。
一部カウント関数を使用しているので、10秒くらいかかるのですが、まあいっかと思っています。

＞1.「どんな風に使うか」を、軽いメモ書きや覚書レベルでいいので残した方がいい
2.コード１行のなかで「'」を入力した以降はコメントとして機能的には無意味になるので、これを活用して「ここはどんな処理をしているか」を残した方がいい
3.もし先々マクロを書き換えたり改良する際は、古い(問題なく動く)バージョンはコピーしてバックアップしておく。

「'」のコメント残しておきます。自分のためにと、次にする人のために。

まだまだ作成したいものが多くあります。
このサイトで質問させていただくこと、あるかと思いますが、またご指導いただければ助かります。どうぞよろしくお願い致します。
この度は丁寧に教えていただいて、ありがとうございました。

回答No.2

kon555

>>指定したセルに入力のところが上手くいきません
　こういう「マクロが動かない」時のコツなのですが、『上手く行きません』は禁句です。具体的に何が起きているのか、あるいは何が起きていないのかを把握しましょう。
　エラーになるのか、入力がされない(無反応)なのか、別の語句が入力されるのか、それぞれ全て別の現象で、別の原因があります。またVBAではエラーの時にもそれぞれのエラー内容に応じたメッセージが出ますので、それも手掛かりになります。
　つまり『上手くいかないぞ、どうしよう』と悩むのではなく『〇〇となると思ったら△△になったぞ。なぜだろう？』と考えるようにすると、それだけで半歩前進していることになります。

　今回の貴方のコードの場合、おそらくエラーになっていると思います。
なので例えば
『ws2.Range(c) = ws1.Cells(i & 48).Value 』
を
『ws2.Range("A1") = ws1.Cells(i & 48).Value』
　に書き換えてみて下さい。これでA1セルに想定通りの内容が入力されれば「セルの指定の仕方がおかしい」と確定します。
　こうして1つずつ、にじり寄っていくようにして不具合の原因を潰しこんでいくのが、マクロを組むコツです(個人的に、ですが)。

　ちなみに今回のコードの場合、「Set c = ws2.Cells(j, 20)」でRange型で格納したものを「ws2.Range(c)」と展開しようとしているのが原因だと思います。
　ではどう変えればいいのか、おそらくここまで組めているなら簡単に分かると思いますので、どうぞ自力で修正してみて下さい。

お礼

身近に教えていただける方がいないため、いつもネットの情報の切り貼りでした。
考え方を教えていただけて、ほんとうに助かりました。
またいろいろ作成しようと思います。

補足

「Set c = ws2.Cells(j, 20)」でRange型で格納したものを「ws2.Range(c)」のところ、理解できました。ありがとうございます。
その内容から少し変更し、きれいではないかもしれませんが、なんとなくできたように思います！
T（入力箇所）の指定が難しかったので、T（列）、U（行開始）、V（行終了）に分けました。
地道にエラーの内容を確認していきました。
今日一日ですごくできるようになった気がします。
ありがとうございます。

あとは、「どこから追加されたのかが分かるようにもしたいのです。分かるようにというのは、太い罫線が入ってもいいですし、書体が変わってもいいですし、色が変わってもいいです。」ですが、
１日の１回目のマクロボタンと、２回目以降のマクロボタンで分けて、
１回目のマクロボタンでは、データのクリアの後に、下のマクロ
２回目のマクロでは、順番にセルの内容を確認して、最終セルの下線を太く目立つようにしたのちに、下のマクロかと思うのですが、
方向性はいかがでしょうか。アドバイスいただけませんでしょうか。
よろしくお願い致します。

Sub Macro1()
'
Dim i As Long
Dim j As Long
Dim k As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

For i = 3 To ws1.Cells(Rows.Count, 22).End(xlUp).Row
For j = 3 To ws2.Cells(Rows.Count, 18).End(xlUp).Row

If ws1.Cells(i, 22) = ws2.Cells(j, 18) And ws1.Cells(i, 23) = ws2.Cells(j, 19) Then

For k = ws2.Cells(j, 21) To ws2.Cells(j, 22)

If Range(ws2.Cells(j, 20) & k) = "" And WorksheetFunction.CountIf(Range(ws2.Cells(j, 20) & ws2.Cells(j, 21), ws2.Cells(j, 20) & ws2.Cells(j, 22)), ws1.Cells(i, 48)) = 0 Then
Range(ws2.Cells(j, 20) & k) = ws1.Cells(i, 48).Value
k = ws2.Cells(j, 22)
End If
Next

End If
Next
Next
End Sub

回答No.1

kon555

書かれている内容からすればVBAで十分対応できそうなんですが、表の作り方などが印刷用のためあまりデータ処理としては合理的でなく、また『内容が追加されたりと、流動性があるため、それに対応できるようにもしたい』という要望も考えると、正直こうしたQ&Aサイトで対応可能な範囲を超えているように思います。
　ご要望のものを組める組めないで言えば組めるものの、微妙な条件伝達の祖語とか、条件の追加などであっというまに使えない物になります。
　なので貴方自身がVBAのスキルを磨いて、この程度の表作成なら自力で対応できるようになるのが一番てっとり早いと思いますよ。

　書かれている内容からすると、以下の構文2つの組み合わせ程度で可能だと思います。こうしたデータ整形の基本ですので、覚えればきっと役に立ちます。一度やってみて下さい。

・if構文：条件に当てはまる時、当てはまらない時で処理を分岐する
https://office-hack.com/excel/if-vba/

・For Next構文：同様の処理を指定回数繰り返す
https://tonari-it.com/excel-vba-for-next/

　考え方のコツとしては「Sheet1のAV列（番号）をコピーして、sheet2のTで指定したところに貼り付ける。」というような、人間の操作としては合理的な方法を一旦捨てる事です。
　どうせ数百行程度なら、愚直に一行ずつ判定してシート1からシート2に転記を繰り返しても、vbaなら一瞬で終わります。
なのでまず『if構文で、条件に合う時にシート2の任意の場所にデータを入力するマクロ』を組み、For Next構文で『1のマクロをシート1の先頭行から末尾行まで繰り返す』とすればいけます。

補足

コメントありがとうございます。

考え方のコツとしては「Sheet1のAV列（番号）をコピーして、sheet2のTで指定したところに貼り付ける。」というような、人間の操作としては合理的な方法を一旦捨てる事です。のところ、とても参考になりました。

早速作ってみたのですが、条件に当てはまったとき、指定したセルに入力のところが上手くいきません。※のところです。
申し訳ありませんがどこが悪いのか、教えていただけませんでしょうか。
よろしくお願い致します。

まだ全然なのですが、少しずつ作っていこうと思いまして…。

Sub Macro1()
'
Dim i As Long
Dim j As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c As Range

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 3 To ws1.Cells(Rows.Count, 22).End(xlUp).Row
For j = 4 To ws2.Cells(Rows.Count, 18).End(xlUp).Row
If ws1.Cells(i, 22) = ws2.Cells(j, 18) And ws1.Cells(i, 23) = ws2.Cells(j, 19) Then
Set c = ws2.Cells(j, 20)
ws2.Range(c) = ws1.Cells(i & 48).Value ※

End If

Next j
Next i
End Sub