[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『該当がない場合にメッセージBOXでその番号を表示したい』（あらい）
VBA初心者です。 現在、VBAのコードを参考書などを使って作成しています。 findnextを使って作成していますが行き詰まり、自分のやりたい事が出来るか、出来るならばどうすればいいか分かりません。 どなたか教えていただけませんでしょうか。 Excel2003を使用しています。
シートが二つあります。 一つは「リスト」シートでＡ列からＩ列まであり、初期状態ではＢ列のみ記載があります。 もう一つは「データ」シートでやはりＡ列からＨ列まであり、それぞれの列に日付や金額など項目が記載されています。 現段階では記載がない項目もありますが、売上が上がれば、項目に随時入力されていきます。現在は30行ですが、今後もっと増える予定です。
作りたいものは、Findnextを使ってリストシートのＢ列に抽出キーとなる番号（Ａ01-34)などの番号を入れるとデータシートのＡ列から完全一致の番号を検索し 新シート「抽出シート」のＡ列以降にデータシートのＡ列からＨ列までを全て転記しています。 そしてさらにその「抽出シート」から「リストシート」のＢ列と一つとんでＤ列以降へ順番に上書きする形で転記しています。 抽出キーとなる番号（Ａ01-34)は、会社ごとの番号で、同じ会社で売上があがるたびに同じ番号がふられるのでデータシート側には重複して何件も出てきます。
リストシートには会社ごとに並び替えて情報を蓄積していきたいので、リストシートのＢ列にはＡ01-34、Ａ01-40というようにいくつも番号を入力し、 ①リストシート入力→②データシートから抽出リスト転記→③リストシートへ転記 という状況です。 リストシートへの転記は一行ごとにコメントをいれたいので、一行転記すると空白行をつくり一行おきに転記しています。
最終的にはリストシートに情報が入っていればいいだけなので抽出リストは必要ないのですが、抽出リストなしで直接転記してみたところ、 データシートに売上日など項目内容が違う重複する番号があるため、リストシートＢ列にも重複番号データが転記され、それは正しいのですが、 Ｂ列にキー番号をさらに追加して検索すると、リストシートの重複番号を認識して同じデータを重複している分だけもう一度検索をかけてデータを転記してしまうのです。 つまり、リストシートに２件同じ番号の項目違いのデータがある場合、もう一度検索した際には２×２の４件転記し、項目まで完全に重複している行が出来てしまうのです・・・。 これをもう一度実行すると、今度は４×２でまた増えてしまいます。 これを防ぐために、抽出リストに一度転記して、項目まで完全に一致している行があれば削除してからリストシートへコードを作りました。
教えていただきたいのは、 ①最終的にリストシートＢ列とデータシートのＡ列を対応させリストシートのＤ列～Ｊ列とデータシートのＢからＨまでを対応させ リストシートへ一行おきに転記したいだけなのですが、上記のような作業をするしか方法はないのか？ ②上記方法でやるとして、現状ではリストシートに上書きしていくと例えば間違えた抽出キーを入力した際にもデータがなかったという情報が表示されません。 データシートに情報がなかった場合には、「Ａ01-50という番号はありません。 確認してください」というようなメッセージBOXを表示させたいのですが、どうしたらいいのでしょうか？
わかりにくい説明で申し訳ありませんがどなたかわかる方宜しくお願い致します。
リストシートへの戻しが、よくわからない。 たとえばリストシートの B1 に Ａ01-34、B2 に Ａ01-40 とあって、それぞれ、データシートに該当が2件ずつあったとする。 この場合、リストシートは具体的にどんなイメージになるのかな？ サンプルを示してくれればありがたいね。
(ぶらっと)
説明不足で申し訳ありませんでした。
リストシート(初期の状態)から、下記のデータシートにて抽出します。(例)
A | B | C | D ～J
1 | A01-34 | |
2 | A01-40 | |
3 | | |
4 | | |
5 | | |
データシート
A | B | C | D ～H
1 A01-34 | 東京 | 1/1 |10,000
2 A01-40 | 大阪 | 2/1 | 3,500
3 F02-14 | 京都 | 3/15|50,000
4 A01-34 | 北海道 | 7/2 |40,000
5 A01-40 | 青森 | 3/10 | 5,000
検索語、 最終的にリストシートは下記のようにしたいです。 行の1と2、3と4などそれぞれ結合セルになっているので一行おきに転記するようにしています。 現状では、抽出シートのA列以降に転記の過程を踏んでいます。
リストシート
A | B | C | D |E |F |G ～J
1 | A01-34 | |東京 |1/1 |10,000 |
2___________________________________________________________
3 | A01-34 | |北海道 |7/2 |40,000 |
4____________________________________________________________
5 | A01-40 | |大阪 |2/1 | 3,500 |
6____________________________________________________________
7 | A01-40 | |青森 |3/10 | 5,000 |
8 _______|___________|______|________|______|________|_______
この状態で、「F02-14」を追加入力して検索すると
リストシート
A | B | C | D |E |F |G ～J
1 | A01-34 | |東京 |1/1 |10,000 |
2___________________________________________________________
3 | A01-34 | |北海道 |7/2 |40,000 |
4____________________________________________________________
5 | A01-40 | |大阪 |2/1 | 3,500 |
6____________________________________________________________
7 | A01-40 | |青森 |3/10 | 5,000 |
8 _______|___________|______|________|______|________|_______
9 | F02-14 | | | | |
10____________________________________________________________
下記のようになってしまいます！(現状)
A | B | C | D |E |F |G ～J
1 | A01-34 | |東京 |1/1 |10,000 |
2___________________________________________________________
3 | A01-34 | |北海道 |7/2 |40,000 |
4____________________________________________________________
5 | A01-34 | |東京 |1/1 |10,000 | ←重複
6___________________________________________________________
7 | A01-34 | |北海道 |7/2 |40,000 | ←重複
8____________________________________________________________
9 | A01-40 | |大阪 |2/1 | 3,500 |
10____________________________________________________________
11 | A01-40 | |青森 |3/10 | 5,000 |
12 _______|___________|______|________|______|________|_______
13 | A01-40 | |大阪 |2/1 | 3,500 | ←重複
14____________________________________________________________
15 | A01-40 | |青森 |3/10 | 5,000 | ←重複
16 _______|___________|______|________|______|________|_______
17 | F02-14 | |京都 |3/15 50,000 |
18____________________________________________________________
そのため重複を抽出リストで削除してからリストシートへ転記しています。 リストシートが結合セルがあるので、リストシートでの削除が上手くいかなくて・・。
そして抽出リストからリストシートへ上書きしている状態なので、もしリストシートへ入力する番号を間違えたりしても何もエラーがおきず、あるものが転記されているだけなのです。 これでは間違った場合に気づかなくなる可能性がありマズイと思い、治したいのですがもうどうしたらいいのやら・・。 メッセージＢＯＸで「この番号はない」と表示するか、入れた番号がエラーなら処理されず、その部分のセルだけが赤くなるとかでもいいのですが・・。
VBAで出来ること、出来ないことの境も分からず、皆さまのお知恵を拝借したいと思った次第です。 宜しくお願い致します。 (あらい)
データシートからリストシートへの転記はデータシートのデータををコードの昇順で並び替えするだけのように思いますが。 また転記するのは「すべてのデータ」なのか、必要なものだけ(一部のデータのみ)を指定、すなわち「Ｂ列に記入したものだけ」なのかはっきりしません。 (NB)
データの並び替えは、元の(データシート)のデータは加工したくないので作業用のシートを用意し、すべてのデータをそのままコピーしてから行うのがいいのでは。 転記したいデータを指定するには、１つのコードに複数のデータが対応するので転記したい表に記入するのはやりにくくなります。 データシートのデータの「コード」だけを表(昇順)にし、その中から、必要なデータを指定(チェックあるいは、「１」を記入等)する方法なら、存在しないコードを指定することはありません。(NB)
まず、コードと言うより、このレイアウト自体に、ちょっと、無理っぽいというか、扱いにくいところがあるね。
処理を行うためのキーがある場所と、その結果を納める場所が同じ。 ということは、次に、実行しようとすると、結果として納められたデータも、あらたに抽出すべき、キーのように（ＶＢＡコードから）見えてしまう。
このままやるなら、抽出されてデコード済みのデータ（Ｂ列以外に値があるデータ）は抽出対象とはしない制御が必要。
コードがアップされていないので、なんともいえないけど、そのあたりの判定が不足しているのでは？ ある程度、それはコードで行われているんだと想像。でないと、アップされた例では、重複の数がもっと多くなるはず。 なので、『不足』とコメントしておこう。
レイアウト的には、抽出キーをいれるシートと抽出して転記するシートを別にするのが、やりやすいとおもうよ。
(ぶらっと)
追記で。
このままのレイアウトで目的を達成する、『力技』のコードも、もちろん書ける。 もしかして、FInd/FindNextの使い方の練習という意図もあるのかもしれないし。
でも、本件を、もっとも効率的に行おうとすれば、
１．抽出キーを入れるシートは別シートにする。抽出キーを入れる場所はＢ列じゃなくても、どこでもＯＫ。 （たとえばＡ列） ２．抽出キーを入れるシートと、データシートは、1行目を『タイトル行』にしておく。 （データシートのＢ列と、抽出キーシートの列のタイトルは同じ文字列にしておく）
こうした上で、 ・リストシートのセルをすべてクリア ・抽出キーシートの内容をCriteriaにして、データシートからリストシートにフィルターオプションで抽出。
この方式が定番というか、もっとも簡単。 この一連の操作をマクロ記録すれば、必要なコードが生成されるよ。
データがなかったキー、メッセージじゃなく、色塗りでもいいなら そのキーのセルに条件付き書式 数式として、CountIf あたりで、データシートの当該キーの件数を取得したものが0なら 書式で背景色を赤とか。
(ぶらっと)
お返事ありがとうございます。
意図をご理解いただくための説明が足らないようで申し訳ありません。
データシートからリストシートへの転記はデータシートのデータををコードの昇順で並び替えするだけのように思いますが。 また転記するのは「すべてのデータ」なのか、必要なものだけ(一部のデータのみ)を指定、すなわちＢ列に記入したものだけ」なのかはっきりしません。
転記したいものは、B列に記入したものだけです。
データシートには不要なデータもたくさん入っていますので。
必要なデータを指定（チェック）して抽出という方法なら、確かに不要なコードを指定することはありませんね。
ただ、今申し上げたようにデータシートにはその時には不要なデータもたくさん入っていますので、30件を一気に抽出しようとした場合に、それを不要なものも入り混じっているコード表の中でチェックしていくのはちょっと量が多すぎます。
やはり、私の意図しているものがVBAでは無理がありましたかね。
(あらい)
お返事ありがとうございました。
やはり、このレイアウトがまず良くないのですね。
自分で作成していてもやりにくさを非常に感じました。
そもそも、最初は抽出するキーを入力するシートを作り、リストシートには直接記載しないようにしていたのですが、社内の大きな力が働き(笑)このような形態で進めざるを得なかったのです。
現在のコードは、会社にから持ち出し出来なかったでお見せ出来ないのですが、リストシートに転記済みのものでも、例えば分割払いで、項目内容が最初は空白だけれど翌月には売上て数値が更新されているものもあるので常に再度検索をかけて情報の更新をしています。
いろいろなアドバイスとご指摘ありがとうございます。
標準的な方法も教えて下さって勉強になります。
VBAってやはり難しいですね・・。
最初からこんなややこしいことをやるとは思いませんでした。
やはり皆さんの意見としては、抽出キーを入れるシートはリストシートではなく別にして、というのが基本ですよね。確かに私もそれが普通だと思います。
また、メッセージBOXで番号表示するというのもおそらく出来ないということなんでしょうね。
その前段階の設定がなってないからですかね。
うーん、どうしたらいいか悩んでみます・・。
あぁ、レイアウトの不自然さは、会社の業務要件が、裏にあるということなんだね。 それにしても、初期段階のリストシートはセル結合がなく、抽出結果をセル結合して、リストシートを 『作り直し』、次は、そのセル結合されたリストシートを元にして抽出？ 少なくとも、この場合、最初の抽出と、2回目以降の抽出って、ロジックが違ってくると思う。 最初からセル結合されているのなら、うなずけないでもないけどね。
(ぶらっと)
>やはり、私の意図しているものがVBAでは無理がありましたかね >また、メッセージBOXで番号表示するというのもおそらく出来ないということなんでしょうね
いやいや、ＶＢＡで、問題なく（？）できるよ。↑で聞いた、最初は結合無し-->次回から結合 という まか不思議な（？）状況の説明・確認がもらえればコードを書いてアップしてもいい。
未登録コードのメッセージについても、コメントしたように条件付き書式がいいとは思うけど 抽出処理後に、該当のないものを、まとめて表示することもできるし、抽出しながら未登録のものを その都度、表示することもできる。
また、いっそのこと、Ｂ列に入力した時点で、登録無ければエラー表示して、入力を取り消すこともできるし それこそ、Ｂ列に入力規則を仕掛けておくこともできるよね。
(ぶらっと)
お返事ありがとうございました！
〉最初は結合無し-->次回から結合 という
〉まか不思議な（？）状況の説明・確認がもらえればコードを書いてアップしてもいい。
私が大変なミスをしていました！！！
セルは最初から結合されています。
リストシート(初期)
A | B | C | D ～J 1 | A01-34 | | 2__________________________________ 3 | A01-40 | | 4 ____|___________|______|___________ 5 | | | 6 ____|___________|______|____________
貴重なお時間を頂いて人に教えて頂くのに、基本的な部分でミスをしているなんて・・・。
本当に申し訳ありませんでした(＞＜)
〉未登録コードのメッセージについても、コメントしたように条件付き書式がいいとは思うけど抽出処理後に、該当のないものを、まとめて表示することもできるし、抽出しながら未登録のものをその都度、表示することもできる。
〉また、いっそのこと、Ｂ列に入力した時点で、登録無ければエラー表示して、入力を取り消すこともできるしそれこそ、Ｂ列に入力規則を仕掛けておくこともできるよね。
→上記のお話は、条件付き書式で背景を色付けするお話は「リストシート」の方で出来ますでしょうか？
私の作成したコードですと、検索して該当がなかった場合でも該当があったものだけリストシートへ転記され、最初に入力した該当なしの番号は消えてしまい、痕跡がなくなってしまうのです・・・。
番号が消えてしまうということは、背景を色づけるということも出来ないのかな？と、素人考えですが。
このシートは複数で使用する予定ですので抽出リストは基本的には見ず、リストシートのみで処理を終えたいというのが本音です。
ですので、検索出来なかった番号がリストシートに残っているのであれば背景色づけでも良いのですが、そうでなければ、やはりメッセージBOXで表示されていれば使用者がわかりやすいかなと。
未登録コードのメッセージはメッセージさえ出れば詳細は問いませんが、最後に該当なしがまとめて出ればそれを本人が確認して再度入れなおせばよいことかと思っています。
基本的にミスをした場合に気づくための安全策ということなので。
〉また、いっそのこと、Ｂ列に入力した時点で、登録無ければエラー表示して、入力を取り消すこともできるしそれこそ、Ｂ列に入力規則を仕掛けておくこともできるよね。
→こんなことが出来るのですか！！
読み込むデータリストは行が増えて新規の番号のものも発生しますが、それでもですか？
VBAは方法さえ知っていればすごく活用できるのですね！！
まあ、ぶらっとさんほどの方だからこそだと思いますが！
もしよろしければ、是非コードを教えていただきたいです（＞＜）
一番の希望はメッセージボックスで番号を表示する方法です。
あと、申し訳ないですが、本日5時以降より19日まで所要で数日ＰＣを開けません。
それまでは大丈夫ですが。
何か私の不備などありましてもすぐに回答を差し上げられません。
一方的にお願いして投げっぱなしとは大変申し訳なく思います。
それまではちょくちょく確認しますので、どうぞ宜しくお願い致します。
(あらい)
それでは、入力チェックの部分だけを。
おすすめは、VBA処理ではなく、入力規則。エクセルバージョンがわからないので2003でもOKの方法で。
リストシートのB列を選択して入力規則。リストで、元の範囲の所に =INDIRECT("データシート!A:A")
これで入力された時点でエクセルがエラーチェックしてくれる。エラーメッセージも、入力規則設定の ダイアログで、必要なら、任意のものにできるし、また、入力規則特有の▼表示をなくすこともできるね。
で、VBAでやるとすれば、リストシートのシートモジュール（シートタブを右クリックしてコードの表示を選ぶ） に、以下をコピペ。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim flagErr As Boolean
Dim r As Range
Dim erMsg As String
Set r = Intersect(Target, Columns("B"))
If r Is Nothing Then Exit Sub
If Target.Count > 1 Then
flagErr = True
erMsg = "複数セル入力はサポートしていません"
Else
With Sheets("データシート")
If IsError(Application.Match(Target.Value, .Range("A1", .Range("A" & .Rows.Count).End(xlUp)), 0)) Then
flagErr = True
erMsg = Target.Row & "行目に入力された " & Target.Value & " は、データシートに登録されていません"
End If
End With
End If
If flagErr Then
MsgBox erMsg & vbLf & "入力を取り消します"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub
(ぶらっと)
で、本題のほうだけど、今、上でアップしたコードにあわせて、Ｂ列に入力されたら その場で、それにマッチするものを、その行を含めて、その下に追加することを考えている。 つまり、データを打ち込むのは、常に、最後の行。 そうすると、挿入は発生しない。
こういうことでもいい？
もちろん、入力チェックは別にして、抽出と転記はまとめてということもできる。 その場合、どこかまで、2行ずつ結合されているとして、その下の結合されていない行に 入力することはないという前提でいい？ それから、すでに抽出されてＢ列以外に値がある行は、抽出処理対象外でいいね？
この場合、ちょっとだけ悩むのは、抽出しようとして、からぶり。 だからその行は、抽出処理後もＢ列だけ。 で、その下のコードは存在したので、何行か、Ｂ列以外も記入された。
そうすると、抽出済みの行の間に、未抽出の行があることになる。 で、それに気がついてデータシート側を追加した。 この後抽出処理をすると、今度は存在するんだけど、『行挿入』になるねぇ。 できないことはないけど、この状態もカバーしなきゃいけない？
それと、2行ずつ、あらかじめ結合されているとして、どんどん、その行に書き込んでいって 結合されている行を『使い切ってしまっていたら』どうする？
あぁ、それから、一度、マッチして何行か記入されたとする。 その記入済みの行のＢ列を打ち直すということは想定している？ もし、想定していたとして、前回、3行だった。 今回は4行だった、あるいは今回はマッチしなかったという場合、どうしたい？ あるいは、記入済みの行は入力させないとか？
(ぶらっと)
大変お世話になっております。
大変詳細に検討して下さって本当に感謝しております。
ありがとうございます。
自分なりにぶらっとさんの指摘して下さっている部分の仕様を考えてみました。
〉で、本題のほうだけど、今、上でアップしたコードにあわせて、Ｂ列に入力されたら
〉その場で、それにマッチするものを、その行を含めて、その下に追加することを考えている。
〉つまり、データを打ち込むのは、常に、最後の行。
〉そうすると、挿入は発生しない。
〉こういうことでもいい？
→入力チェックはとても便利だとは思いますが、必ずしも今回の件ではこだわっておりませんので優先度は高くないです。別件で使用させていただくかもしれません。
また、データを打ち込むのは常に最後の行というのは問題ありません。
ただ、前回３行検出されて今度は４行抽出されたということが発生するかもしれませんので、そのあたりが問題なければよいのですが。
〉もちろん、入力チェックは別にして、抽出と転記はまとめてということもできる。
〉その場合、どこかまで、2行ずつ結合されているとして、その下の結合されていないに
〉入力することはないという前提でいい？
〉それから、すでに抽出されてＢ列以外に値がある行は、抽出処理対象外でいいね？
→結合されていない行に入力することはありません。
抽出処理対象外で構いません。
〉この場合、ちょっとだけ悩むのは、抽出しようとして、からぶり。
〉だからその行は、抽出処理後もＢ列だけ。
〉で、その下のコードは存在したので、何行か、Ｂ列以外も記入された。
〉そうすると、抽出済みの行の間に、未抽出の行があることになる。
〉で、それに気がついてデータシート側を追加した。
〉この後抽出処理をすると、今度は存在するんだけど、『行挿入』になるねぇ。
〉できないことはないけど、この状態もカバーしなきゃいけない？
→もし出来れば、カバーしていただけると助かります(><)
すいません・・・。
難しければ、そこの未抽出部分の行を削除するなりして、抽出した最後の行の下へ記入して再抽出すればいいんでしょうかね？
〉それと、2行ずつ、あらかじめ結合されているとして、どんどん、その行に書き込んでいって結合されている行を『使い切ってしまっていたら』どうする？
→ある程度幅をもって結合行を作りますので使い切ることはないようにします。
〉あぁ、それから、一度、マッチして何行か記入されたとする。
〉その記入済みの行のＢ列を打ち直すということは想定している？
〉もし、想定していたとして、前回、3行だった。
〉今回は4行だった、あるいは今回はマッチしなかったという場合、どうしたい？
〉あるいは、記入済みの行は入力させないとか？
→打ち直しは想定しています。
データシートは常に増えていき削除はある程度の期間ないという想定ですので、記入済みで前回はマッチしたのに今回はマッチしないということはないと想定しています。
同じ件数か、または増えているという想定です。
記入済みの行は入力させないということは考えていません。
自分で返事を書いていても大変厚かましく、めんどくさい質問とお願いをしていることに申し訳なくなってきました。。。
また何かありましたらご指摘下さい。
未熟なばかりに本当に申し訳ありません。
どうぞ宜しくお願い致します。
(あらい)
それでは、入力チェックは、少なくともコードでは行わないということで考える。 (同時に提言した入力規則で対応したらいいと思うよ）
で、上で確認・説明してくれたことを元にコードを考えてみるけど、実は、とってもハードルの高い仕様要求。 たとえば、あるとき、入力して、５件のデータが生成されたとする。 で、後日、その中のどれかを打ち直した。（同じ値か、別の値かは問わず） その時点では１０行がマッチ。そうすると、その場所に１０件のデータを生成しなきゃいけないけど 同時にと言うか、10件生成の前に、以前生成されていた５件を削除する必要がある。 しかも、打ち直されたものが5件あったうちの、どれかはわからないので、その上と下をみて同じものを 削除することになる。
等々、
ところで、いまさらながらだけど、なぜ2行ずつ結合しているの？ 結合セルが存在するということは、ＶＢＡコードも、シート上でのエクセル操作面でも非常にやりにくくなるよね。 特別な理由があるのかなぁ・・？
いずれにしても、コード案作成は、少し時間がかかると思う。
(ぶらっと)
コード作成案を出して頂けるということで本当にありがとうございます。
やはり、かなり無茶な高度な仕様なのですね・・・。
申し訳ありません。
検討して頂けるということで大変心強く思っております。
〉ところで、いまさらながらだけど、なぜ2行ずつ結合しているの？
〉結合セルが存在するということは、ＶＢＡコードも、シート上でのエクセル操作面でも非常にやりにくなるよね。
〉特別な理由があるのかなぁ・・？
→はい、私も出来れば結合はさせたくないです。
単純なコピペも出来ないし・・。
が、このリストは他部署も使用し今回転記したい情報以外もいろいろ入力し、また最終的には印刷・検印なども行う表フォーマットになる予定です。
その中で手動記載部分項目の中で上下二段に罫線を引いて分け、上下に記載する列項目がいくつもあるのです。ただの一つのセルに二行記載するなどでは対応不可のセルがあり、それに伴ってセルを結合させています。
リストのフォーマット自体は、私が関われない部分なのでこの仕様となってしまいました。
結合セルがあると、VBAのコードとしても高度になり、初心者には難しいというのも調べてわかりました。
ただ、変更出来ない部分でしたのでこのままの体裁でお願いしてしまった次第です。
大変お手数・ご迷惑おかけいたしますが宜しくお願い致します。
(あらい)
とりあえず書いたのでアップ。 そちらのシートの実態が不明なところもあるけど、こちらで解釈して作り上げたシート上では 一応、機能している。
ただし、以下。
１．すでに抽出済みのＢ列に対しても打ち直すことはあるということなので、カバーした。 カバーしたということは、既存のデータもＢ列に打ち直しが入ったら、そのキーで抽出して取り込む。 ２．ただし、その行を最初の行として、抽出したデータを下に【挿入】する。 ３．例えば、リストシートが Ａ Ａ Ａ Ｂ Ｂ Ｂ Ｃ Ｃ Ｃ このようになっていたとする。 で、この２番目のＢをＸに打ち直した、あるいは、同じ値のＢに打ち直した。この場合にも Ｘあるいは、新しく打ち直されたＢで抽出に行く。で、その時点で、データシート側のＸないしはＢが４件だったとする。 そうすると、リストシートは Ａ Ａ Ａ Ｂ Ｘ ないしは Ｂ（新しいＢ） Ｘ ないしは Ｂ（新しいＢ） Ｘ ないしは Ｂ（新しいＢ） Ｘ ないしは Ｂ（新しいＢ） Ｂ Ｃ Ｃ Ｃ このようになる。
４．従って、抽出済みの行を打ち直す場合、それらグループを、１件を残して行削除し、残った１件の行に対して入力することが必要。 ５．通常は、最後の行に入力すると思うけど、そのほかに、途中で行挿入して、そこに打ち込むことも可能。 ６．シートは結合が、ずっと下のほうまでされているということだけど、そのさらに下の結合されていないＢ列に入力しても、それは無視。 ７．入力した値がデータシートになかった場合、セルを赤くする。
では、コード。リストシートのシートタブを右クリックしてでてきたところ（シートモジュール）に以下をコピペ。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim key As Variant
Dim x As Long
Dim v As Variant
Dim y As Long
Dim i As Long
'行挿入・削除なら、何もしない
If Target.Areas(1).Columns.Count = Columns.Count Then Exit Sub
Set r = Intersect(Target, Columns("B"))
If r Is Nothing Then Exit Sub 'B列変更の時のみ
Application.EnableEvents = False
For Each c In r
If c.MergeCells Then '結合セル領域に入力された時のみ
If c.Address = c.MergeArea(1).Address Then
key = c.Value
c.Interior.ColorIndex = xlNone
c.EntireRow.Resize(2).ClearContents
v = getData(key)
If Not IsArray(v) Then
c.Interior.Color = vbRed
c.Value = key
Else
x = UBound(v, 1)
y = c.Row
Rows(y & ":" & y + 1).Copy
Rows(y + 2 & ":" & (x - 1) * 2 + y + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
For i = 1 To x
Cells((i - 1) * 2 + 1 + y - 1, "B") = key
Cells((i - 1) * 2 + 1 + y - 1, "D").Resize(, 7).Value = WorksheetFunction.Index(v, i, 0)
Next
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
Private Function getData(key As Variant) As Variant
Dim v() As Variant
Dim x As Long
Dim k As Long
Dim c As Range
Dim shD As Worksheet
Dim j As Long
Set shD = Sheets("データシート")
x = WorksheetFunction.CountIf(shD.Columns("A"), key)
If x = 0 Then Exit Function
ReDim v(1 To x, 1 To 7) '7 は B～H
Set shD = Sheets("データシート")
For Each c In shD.Range("A1", shD.Range("A" & shD.Rows.Count).End(xlUp))
If c.Value = key Then
k = k + 1
For j = 1 To 7
v(k, j) = c.Offset(, j).Value
Next
End If
Next
getData = v
End Function
(ぶらっと)
ありがとうございます！
まだ動きや内容の読み込みが出来ていないので、これからじっくり確認してみます。
いろいろ難しい仕様を注文してしまって本当にすいませんでした。
取り急ぎ、お礼申し上げます。
(あらい)
上記アップしていただいたコードについて質問です。
基本的な質問で本当に申し訳ないです。
〉では、コード。リストシートのシートタブを右クリックしてでてきたところ（シートモジュール）に以下をコピペ。
→このようにしてみたのですが、これはシートにコードを記載したということですか？
すいません・・。
どうやってコードを起動させるかわからなかったんです(＞＜)
初心者なので、今までは本に記載のあるように標準モジュールに記載して起動の▲が横になったようなマクロの実行ボタンを押すか、エクセルのシートのマクロからマクロ名を選んで実行していたのですが・・。
これはぶらっとさんのおっしゃったやり方でコードをリストシートへ記載して、上記のやり方でやろうとしてもマクロがなくて出来なかったんです。
シートには確実に記載して保存もしてあったのですが・・。
とても基本的な話でお恥ずかしい限りですが、教えていただけませんか。
(あらい)
モジュールには、標準モジュール、ThisWorkbookモジュール、シートモジュール、クラスモジュール それとユーザーフォームモジュールがある。いずれも、ＶＢＥ画面で、モジュールを生成することができる。 シートモジュールは、ＶＢＥ画面の左上にあるプロジェクトエクスプローラにある該当のシートをダブルクリックすると 生成されて表示される。
で、もう１つの方法が、上で説明した方法。 ＶＢＥ画面ではなく、エクセルの画面で、 ・そのリストシートのシートタブを右クリックする。 ・でてきたメニューの中の｢コードの表示｣を選ぶ。 このようにしてもシートモジュールが生成されて、それが表示される。
その、でてきたところに貼り付け。 リストシートそのものに貼り付けても、それは、ただの｢文章｣で、プログラム扱いされない。
で、標準モジュールに書いたマクロは、(あらい)さんが言ったような方法で起動させることができるけど、 シートモジュールに書いたプロシジャは、マクロ名そのものが、マクロの一覧にはでてこないよね。
じゃ、どうやって動かすのかというと・・・動かさない というか、動かす必要がない。 リストシートのシートモジュールに書いた Private Sub Worksheet_Change(ByVal Target As Range) このプロシジャは、リストシートのセルに何かが入力されたら自動的に動く。 で、このコードの中で、入力されたのがＢ列かどうかを判定してＢ列だったら処理をするようにしている。
追記）あぁ、自分の回答を読み直したら >リストシートのシートタブを右クリックしてでてきたところ（シートモジュール）に以下をコピペ。
ごめん、ごめん。｢右クリックしてコードの表示を選ぶ｣と書くべきだったね。
(ぶらっと)
丁寧な説明ありがとうございました。
動きました！
会社ではコードをコピペすることが出来ず手入力していたのもよくなかったようです。
本当にありがとうございました。
ところで、このコードで質問なのですが、
①リストシートのキー列を変更した場合、例えばＣ列にしたい場合は、記載のあるコード「Ｂ」を「Ｃ」に変更すればいいですか？
〉Set r = Intersect(Target, Columns("B"))
〉Cells((i - 1) * 2 + 1 + y - 1, "B") = key
②転記したい列と列範囲を変更したい場合、リストシートのＤ列ではなくＯ列からＡＨ列まで２０列転記したい場合なのですが、
〉 Cells((i - 1) * 2 + 1 + y - 1, "D").Resize(, 7).Value = WorksheetFunction.Index(v, i, 0)
この"D"を"O"に変え、
〉ReDim v(1 To x, 1 To 7) '7 は B～H
〉For j = 1 To 7
上二つの「7」を20に変えたら20列になるということですかね？
①は出来たのですが、②まで変えようとするとちょっと上手くいかず・・。
エラーも下の記述あたりで出てきたので、ここも関わっていますか？
ここは行挿入のコードですよね。
〉Rows(y & ":" & y + 1).Copy 〉 Rows(y + 2 & ":" & (x - 1) * 2 + y + 1).Insert Shift:=xlDown
ステップインなどでも確認出来なかったので、変更する場所が他にあれば教えて頂けると助かります＞＜
また、
③このコードはデータを変えても動きますか？
データシート内に追加入力するというより、新しいデータが追記して書いてあるシートを一定期間ごとに出力するのでそれをデータシートに貼り付けるか読み込ませようと考えていたのですが。
④データシートにないコードをリストシートＢ列に入力した時、赤セルになりました！
ありがとうございます！！
このセルを白に戻したい場合は、正しいコードを入れるという動作でしか白色セルに戻せませんか？
間違っていないコードでも、間違いのコードでも、Deleteキーを押して入力をクリアしても赤セルのままでしたので、一旦入力した後は正しいコードを入れることで白セルに戻せるということかな？と。
色々と難しい仕様をお願いしてすいませんでした。
厚かましいですが、もう一度教えて頂けますと大変助かります。
（あらい）
>①リストシートのキー列を変更した場合、例えばＣ列にしたい場合は、記載のあるコード「Ｂ」を「Ｃ」に変更すればいいですか？
うん。そのはず（？） 試してみて。ただし、抽出結果をでコードする場所はＤ列以降でいいのかな？
このレスの最後の★参照。
>②転記したい列と列範囲を変更したい場合、リストシートのＤ列ではなくＯ列からＡＨ列まで２０列転記したい場合なのですが、 > Cells((i - 1) * 2 + 1 + y - 1, "D").Resize(, 7).Value = WorksheetFunction.Index(v, i, 0) >この"D"を"O"に変え、 >ReDim v(1 To x, 1 To 7) '7 は B～H >For j = 1 To 7 >上二つの「7」を20に変えたら20列になるということですかね？
もう１つ、 Cells((i - 1) * 2 + 1 + y - 1, "D").Resize(, 7).Value = WorksheetFunction.Index(v, i, 0) これそのものの 7 も。
このレスの最後の★参照
>③このコードはデータを変えても動きますか？
たとえば、別シートにある縦の列のデータをコピーして、このシートのＢ列にペーストするということ？ そういったことを、カバーするために複数のセルへの同時入力はカバーしているので試してみて。 ただし、Ｂ列は、悪評高い（？）結合領域なので、コピーする別シートの縦のセル群も、同じ形に結合されていないと エクセル側ではじかれてしまうね。
>データシート内に追加入力するというより、新しいデータが追記して書いてあるシートを一定期間ごとに出力するので >それをデータシートに貼り付けるか読み込ませようと考えていたのですが。
前項で対応できるなら、それで。 もし、具合が悪いようなら、別シート（もしかしたら別ブックの別シート？）から、自動的に取り込んで このシートの上で処理させるようなマクロを準備しておくことはできるよ。
>④このセルを白に戻したい場合は、正しいコードを入れるという動作でしか白色セルに戻せませんか？
仕様として、空白入力の場合は、色を消すということであれば、それは簡単にできるよ。
★ 将来のレイアウト変更等で、たとえばチェックする列を変更するとか、でコードする列を減らすとか増やすとか あるいは、でコードするものの開始列を変えるとか そういう場合のコードメンテナンスを最小にするために それらを、コードの先頭でコンスタント値として規定しておく方法がある。
もし、お望みなら、①、②、④ 含めて、後程コードをアップするけど？ また、③については、その要件をクリアにしてもらえれば、コピーマクロもアップすることができるけど？
(ぶらっと)
とりあえず ①、②、④ 対応。 ほとんどの要件は、先頭のConst群を変更すれば、コードそのものは変更不要。 コードを総入れ替え。
Option Explicit
'リストシートの規定 Const keyColL As String = "C" Const copyColL As String = "D" 'この列から右にコピー Const copyCells As Long = 20 'データシートの規定 Const keyColD As String = "A" Const copyCol As String = "B" 'この列から右をコピー
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim key As Variant
Dim x As Long
Dim v As Variant
Dim y As Long
Dim i As Long
'行挿入・削除なら、何もしない
If Target.Areas(1).Columns.Count = Columns.Count Then Exit Sub
Set r = Intersect(Target, Columns(keyColL))
If r Is Nothing Then Exit Sub '指定列変更の時のみ
Application.EnableEvents = False
For Each c In r
If c.MergeCells Then '結合セル領域に入力された時のみ
If c.Address = c.MergeArea(1).Address Then
key = c.Value
c.Interior.ColorIndex = xlNone
c.EntireRow.Resize(2).ClearContents
If Len(key) > 0 Then
v = getData(key)
If Not IsArray(v) Then
c.Interior.Color = vbRed
c.Value = key
Else
x = UBound(v, 1)
y = c.Row
Rows(y & ":" & y + 1).Copy
Rows(y + 2 & ":" & (x - 1) * 2 + y + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
For i = 1 To x
Cells((i - 1) * 2 + 1 + y - 1, keyColL) = key
Cells((i - 1) * 2 + 1 + y - 1, copyColL).Resize(, copyCells).Value = WorksheetFunction.Index(v, i, 0)
Next
End If
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
Private Function getData(key As Variant) As Variant
Dim v() As Variant
Dim x As Long
Dim k As Long
Dim c As Range
Dim shD As Worksheet
Dim j As Long
Set shD = Sheets("データシート")
x = WorksheetFunction.CountIf(shD.Columns(keyColD), key)
If x = 0 Then Exit Function
ReDim v(1 To x, 1 To copyCells)
Set shD = Sheets("データシート")
For Each c In shD.Range(keyColD & 1, shD.Range(keyColD & shD.Rows.Count).End(xlUp))
If c.Value = key Then
k = k + 1
For j = 1 To UBound(v, 2)
v(k, j) = c.Offset(, j).Value
Next
End If
Next
getData = v
End Function
(ぶらっと)
①、②、④は↑で試してみてほしいけど、あぁ、そうか。③は、リストシートへの入力ではなく、データシートへの追加あるいは変更だったんだね。
もちろん、データシートが何行になろうと、それは問題ないけど、言っている意味が
・すでにリストシートに何行かキーが打ち込まれてデータシートから抽出されて転記状態。 ・この状態でデータシートがわを入れ替えたとき、すでにリストシートにあるものを、新しいデータシートの内容で 一括して洗い替え。
こういうことかな？
これはこれで、コードを書いてもいいけど？
(ぶらっと)
もし③が、↑でいったような理解なら、シートモジュールを総入れ替え。 加えて標準モジュールにマクロを追加。洗い替えは、この追加したマクロを実行。
【シートモジュール】
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim key As Variant
Dim x As Long
Dim v As Variant
Dim y As Long
Dim i As Long
'行挿入・削除なら、何もしない
If Target.Areas(1).Columns.Count = Columns.Count Then Exit Sub
Set r = Intersect(Target, Columns(keyColL))
If r Is Nothing Then Exit Sub '指定列変更の時のみ
Application.EnableEvents = False
For Each c In r
If c.MergeCells Then '結合セル領域に入力された時のみ
If c.Address = c.MergeArea(1).Address Then
key = c.Value
c.Interior.ColorIndex = xlNone
c.EntireRow.Resize(2).ClearContents
If Len(key) > 0 Then
v = getData(key)
If Not IsArray(v) Then
c.Interior.Color = vbRed
c.Value = key
Else
x = UBound(v, 1)
y = c.Row
Rows(y & ":" & y + 1).Copy
Rows(y + 2 & ":" & (x - 1) * 2 + y + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
For i = 1 To x
Cells((i - 1) * 2 + 1 + y - 1, keyColL) = key
Cells((i - 1) * 2 + 1 + y - 1, copyColL).Resize(, copyCells).Value = WorksheetFunction.Index(v, i, 0)
Next
End If
End If
End If
End If
Next
Application.EnableEvents = True
End Sub
Private Function getData(key As Variant) As Variant
Dim v() As Variant
Dim x As Long
Dim k As Long
Dim c As Range
Dim shD As Worksheet
Dim j As Long
Set shD = Sheets("データシート")
x = WorksheetFunction.CountIf(shD.Columns(keyColD), key)
If x = 0 Then Exit Function
ReDim v(1 To x, 1 To copyCells)
Set shD = Sheets("データシート")
For Each c In shD.Range(keyColD & 1, shD.Range(keyColD & shD.Rows.Count).End(xlUp))
If c.Value = key Then
k = k + 1
For j = 1 To UBound(v, 2)
v(k, j) = c.Offset(, j).Value
Next
End If
Next
getData = v
End Function
【標準モジュール】
Option Explicit
'リストシートの規定 Public Const keyColL As String = "C" Public Const copyColL As String = "D" 'この列から右にコピー Public Const copyCells As Long = 20 'データシートの規定 Public Const keyColD As String = "A" Public Const copyCol As String = "B" 'この列から右をコピー
Sub 洗い替え()
Dim c As Range
Dim dic As Object
Dim d As Variant
Dim z As Long
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
Sheets("リストシート").Activate
z = Range(keyColL & Rows.Count).End(xlUp).Row
For Each c In Columns(keyColL).Cells
If Not c.MergeCells Or c.Row > z Then Exit For
If c.Address = c.MergeArea(1).Address And Len(c.Value) > 0 Then dic(c.Value) = True
Next
Application.EnableEvents = False
Cells.ClearContents
Application.EnableEvents = True
Set c = Range(keyColL & 1)
For Each d In dic
c.Value = d
DoEvents
DoEvents
Set c = Range(keyColL & Rows.Count).End(xlUp).Offset(1)
Next
Application.ScreenUpdating = True
MsgBox "洗い替え完了"
End Sub
(ぶらっと)
す、すごいです！
ありがとうございます！！
〉★ 将来のレイアウト変更等で、たとえばチェックする列を変更するとか、でコードする列を減らすとか増やすとかあるいは、でコードするものの開始列を変えるとか そういう場合のコードメンテナンスを最小にするためにそれらを、コードの先頭でコンスタント値として規定しておく方法がある。
→そうなんです。変更が生じるかもしれず、その場合に変更が出来ないと困ってしまうので・・。
こんな風にコードの先頭で規定するということが出来るのですね。
そんなことが出来るとは全く知りませんでした。
VBAはぶらっとさんのように精通しているといろいろなことが出来るのですね。
これから少しづつ、ぶらっとさんのコードをお手本に勉強していきたいです。
〉①、②、④は↑で試してみてほしいけど、あぁ、そうか。③は、リストシートへの入力ではなく、データシートへの追加あるいは変更だったんだね。
〉もちろん、データシートが何行になろうと、それは問題ないけど、言っている意味が
〉・すでにリストシートに何行かキーが打ち込まれてデータシートから抽出されて転記状態。
〉・この状態でデータシートがわを入れ替えたとき、すでにリストシートにあるものを、新しいデータシートの内容で一括して洗い替え。
〉こういうことかな？
→おっしゃる通りです。
これが出来ると本当に助かります。
早速明日、コードを試してみたいです。
何パターンも準備して下さり頭が下がります。
ありがとうございます。
明日また動きを検証してきます！
ありがとうございました！！
(あらい)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.