[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『注文依頼内容の抽出方法についって、』(Cou)
商品データー表を基に別シートの注文依頼書に依頼情報を抽出し注文しています。
マクロでJ列にID番号を入力すると、C列に商品名・D列に型番・E列に型式等入るようにと思っています。
ID番号は、商品データー表では、B列に入っていて、それ以降に商品情報が入っています。
注文依頼書にVlookupをマクロで出来たらと思い、いろいろ調べて下記マクロを作ったのですが、
これで行くと注文書は約20行有るのですが、20行分のマクロを入力しなければなりません。
出来れば、J列にID番号を入力すれば、同じ行のC列・D列・E列・・・と入力できる事は、出来るのでしょうか、
データー表の中には、ID番号が無い物もあり関数上に直接入力する場合がありますので、マクロで出来ればと考えています。
マクロは難しくよく分かりません。ご迷惑をお掛けすると思いますが、宜しくご教授をお願いします。
Sub VLookup()
Dim tbl As Range Set tbl = Sheets("sheet1").Range("b1:k700") Dim key As Long key = Range("j1").Value key1 = Range("j2").Value key2 = Range("j3").Value key3 = Range("j4").Value
On Error Resume Next Dim ret As String ret = WorksheetFunction.VLookup(key, tbl, 3, False) ret1 = WorksheetFunction.VLookup(key, tbl, 5, False) ret2 = WorksheetFunction.VLookup(key, tbl, 7, False) ret3 = WorksheetFunction.VLookup(key, tbl, 10, False) ret4 = WorksheetFunction.VLookup(key1, tbl, 3, False) ret5 = WorksheetFunction.VLookup(key1, tbl, 5, False) ret6 = WorksheetFunction.VLookup(key1, tbl, 7, False) ret7 = WorksheetFunction.VLookup(key1, tbl, 10, False)
On Error GoTo 0 Range("B1").Value = ret Range("c1").Value = ret1 Range("d1").Value = ret2 Range("e1").Value = ret3 Range("B2").Value = ret4 Range("c2").Value = ret5 Range("d2").Value = ret6 Range("e2").Value = ret7
If Cells(2, 3) = "" Then MsgBox "該当データーがありませんでした。" End If End Sub 宜しくお願いします。
< 使用 Excel:Excel2008(Mac)、使用 OS:WindowsXP >
こんにちは ^^ 気が付いた点だけで、恐縮ですが。。。 せっかくマクロをおつかいなら、vlookupも便利ですが 直接テーブルから条件文で引っ張ってくるのも一手かと あと コードだけで データーの詳細が分かりにくいので 具体的に シート名、セルアドレス、(型)書式、 など情報の中身はダミーで代替でもよいかと思いますが、現状、得たい結果と振り分けてわかりやすく さらにご説明いただくと、多数アドバイスがあるかもしれませんね。 でわ
(隠居じーさん) 2019/01/20(日) 14:39
>シート名、セルアドレス、(型)書式、
シート名は、商品データー表です。同じブックの別シートで注文依頼書を作成しようと思っています。
別ブックで注文依頼書を作ろうと思ったのですが旨く行きませんでした。
商品データー表には、元表はC列にID番号(数字)・D列に商品名(文字)・E列に型番(英数)・F列に 型式(英 数)とG、H、I・・なっております。質問の説明になっているのか分かりませんが、説明不足で 申し訳ありません。宜しくお願いします。
(Cou) 2019/01/20(日) 15:12
すみませんm(__)m
>元表はC列にID番号(数字)・D列に商品名(文字)・E列に型番(英数)・F列に 型式(英 数)とG、H、I・・なっております
訂正・・D列に商品名・F列に型番(英数)・H列に型式等になっています。申し訳ありません。
(Cou) 2019/01/20(日) 15:18
商品データー
A B C D E F G 1 ID 商品名 産地 型番 寸法 型式 備考 2 11 りんご 東京 1−111−1 10 G-11-1 3 12 みかん 埼玉 1−111−2 11 G-11-2 4 13 イチゴ 大阪 1−111−3 12 G-11-3 5 14 ぶどう 東京 1−111−4 13 G-11-4 6 15 オレンジ 埼玉 1−111−5 14 G-11-5 7 16 メロン 大阪 1−111−6 15 G-11-6 8 17 西瓜 東京 1−111−7 16 G-11-7 9 18 栗 埼玉 1−111−8 17 G-11-8
上の表から抽出し下記表に必要項目を取り込みたいのです。出来るでしょうか。
現在VLookup関数で行っているのですが、IDに載っていない商品がありますその場合、関数の上から入力
しています。入力した古い記録が残っていいる場合があり困っています。
商品発注書
A B C D J 1 商品名 型番 型式 備考 ID 2 みかん 1-111-2 G-11-2 12 3 メロン 1-111-6 G-11-6 16 4 オレンジ 1-111-5 G11-5 15 5 6 7 宜しくお願いします。 (Cou) 2019/01/20(日) 15:57
(隠居じーさん) 2019/01/20(日) 17:07
忙しい所大変申し訳ありません。
お返事頂けただけで有難く思います。有難うございます。
(Cou) 2019/01/20(日) 17:18
【商品データ】シート
___A_____B________C______D______E_____F______G___ 1 ID 商品名 産地 型番 寸法 型式 備考 2 11 りんご 東京 1-111-1 10 G-11-1 3 12 みかん 埼玉 1-111-2 11 G-11-2 4 13 イチゴ 大阪 1-111-3 12 G-11-3 5 14 ぶどう 東京 1-111-4 13 G-11-4 6 15 オレンジ 埼玉 1-111-5 14 G-11-5 7 16 メロン 大阪 1-111-6 15 G-11-6 8 17 西瓜 東京 1-111-7 16 G-11-7 9 18 栗 埼玉 1-111-8 17 G-11-8
【商品発注書】
______A_________B_______C_______D_____E___ 1 商品名 型番 型式 備考 ID 2 みかん 1-111-2 G-11-2 12 3 メロン 1-111-6 G-11-6 16 4 オレンジ 1-111-5 G-11-5 15 5
(もこな2) 2019/01/20(日) 17:40
お世話になります。申し訳ありません。慣れないもので、次回からきを付けます。
ご指摘有難うございました。
(Cou) 2019/01/20(日) 17:50
こんばんは もっとスマートな方法がきっとあると思いますが。 ^^ 年寄りの力技で ^^;
ご提示の通り シート名 商品データ A B C D E F G 1 ID 商品名 産地 型番 寸法 型式 備考 2 11 りんご 東京 1−111−1 10 G-11-1 3 12 みかん 埼玉 1−111−2 11 G-11-2 4 13 イチゴ 大阪 1−111−3 12 G-11-3 5 14 ぶどう 東京 1−111−4 13 G-11-4 6 15 オレンジ 埼玉 1−111−5 14 G-11-5 7 16 メロン 大阪 1−111−6 15 G-11-6 8 17 西瓜 東京 1−111−7 16 G-11-7 9 18 栗 埼玉 1−111−8 17 G-11-8
シート名 商品発注書(空) j2 以降にIDを入力後、下記マクロを実行してください。
バックアップ必須ですので、新規BOOKにてお試しください。
Option Explicit Sub main() Dim s_in As Worksheet Dim s_out As Worksheet Dim i As Long Dim j As Long Set s_in = Worksheets("商品データ") Set s_out = Worksheets("商品発注書") With s_in s_out.Range("A:I,J1").Clear s_out.Cells(1, 1).Resize(1, 4) = Array("商品名", "型番", "型式", "備考") s_out.Cells(1, 10) = "ID" For i = 1 To s_out.Cells(s_out.Rows.Count, 10).End(xlUp).Row For j = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row If s_out.Cells(i, 10) = .Cells(j, 1) Then s_out.Cells(i, 1) = .Cells(j, 2) s_out.Cells(i, 2) = .Cells(j, 4) s_out.Cells(i, 3) = .Cells(j, 6) s_out.Cells(i, 4) = .Cells(j, 7) End If Next Next End With End Sub
シートのイベントをマクロ起動スイッチにすれば もっと便利かもです。 m(_ _)m (隠居じーさん) 2019/01/20(日) 17:55
【商品データ】シート
___A_____B________C______D______E_____F______G___ 1 ID 商品名 産地 型番 寸法 型式 備考 2 11 りんご 東京 1-111-1 10 G-11-1 3 12 みかん 埼玉 1-111-2 11 G-11-2 4 13 イチゴ 大阪 1-111-3 12 G-11-3 5 14 ぶどう 東京 1-111-4 13 G-11-4 6 15 オレンジ 埼玉 1-111-5 14 G-11-5 7 16 メロン 大阪 1-111-6 15 G-11-6 8 17 西瓜 東京 1-111-7 16 G-11-7 9 18 栗 埼玉 1-111-8 17 G-11-8
【商品発注書】シート
______A_________B_______C_______D____...__J_ 1 商品名 型番 型式 備考 ID 2 みかん 1-111-2 G-11-2 12 3 メロン 1-111-6 G-11-6 16 4 オレンジ 1-111-5 G-11-5 15 5
そして、マクロではなくとりあえず数式案。(備考欄は文字列が入るものとする)
(1)【商品発注書】シートのA2セルに以下の数式を設定 =IFERROR(INDEX(商品データ!$A$1:$G$1000,MATCH($J2,商品データ!$A$1:$A$1000,FALSE),MATCH(A$1,商品データ!$A$1:$G$1,FALSE))&"","") (2)(1)をB2〜D2にフィルコピー (3)(2)を3行目〜必要なだけフィルコピー
(もこな2) 2019/01/20(日) 18:07
お世話になります。
隠居じーさん様
実行時エラー9でインデックスが有効範囲でありませんと出ます。
テストBOOKで行っているのですが、テストの商品データー範囲が間違っているのでしょうか。
マクロが分かっていなくて申し訳ありません。
ご指導のほど宜しくお願いします。
(Cou) 2019/01/20(日) 18:25
マクロでやるなら、隠居じーさんさんが仰るとおりChangイベントで処理するのが良さそうですね。
Private Sub Worksheet_Change(ByVal Target As Range) Dim MyRNG As Range, MyROW As Variant Dim tmp As Variant, buf(3) As Variant, i As Long
Stop '←ここで止まるからステップ実行して研究のこと
'変更があったセルにJ列のセルが含まれていなければ即終了 If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'イベント抑制する
'変更があったセルのうちJ列のものを1セルずつ処理 For Each MyRNG In Intersect(Target, Range("J:J")) With Worksheets("商品データ") MyROW = Application.Match(MyRNG.Value, .Range("A:A"), False)
'MATCH関数がエラーになるか判定 If IsError(MyROW) Then
'エラーになりかつ、ブランクセルに変更(値がクリア)された場合 If MyRNG = "" Then Cells(MyRNG.Row, "A").Resize(, 4).ClearContents Else
'エラーにならない場合 For Each tmp In Array("B", "D", "F", "G") buf(i) = .Cells(MyROW, tmp).Value i = i + 1 Next tmp
Cells(MyRNG.Row, "A").Resize(, 4).Value = buf
End If End With Next MyRNG
Application.EnableEvents = True 'イベント再開
End Sub
(もこな2) 2019/01/20(日) 18:54
お世話になります。
> With Worksheets("商品データー")でデバッグになります。シート名に問題がありそうなので、
見ていきます。分からないところを再度ご教授をお願いします。
隠居ジー様 もなこ2様有難うございます。
(Cou) 2019/01/20(日) 19:26
細かい話ですが「デバッグになる」ではなく、「実行時エラーが発生して、デバッグ(作業)するか、そのまま終わらせるのか聞かれている」状態です。
そして、そこでエラーが発生するのであれば、推察されているとおりそのブックに「商品データー」というシートが存在しないのでは?
一文字たりとも違っていてはダメなので、たとえば
「商品データ」というシートが存在していても、 「商品データー」という名前のシートを操作しようとすると
失敗(エラーが発生)します。
(もこな2) 2019/01/20(日) 19:38
こんばんは ^^ え〜と。。。もこな2さんの、ご説明とおなじことかもしれませんね。 実際のシート名がマクロコードのシート名と 違っていませんでしょうか? ご確認お願いいたします。 もし 違っていればマクロコードのシート名を 実際のシート名に変えて下さいね。
Set s_in = Worksheets("商品データ") Set s_out = Worksheets("商品発注書")
多分この部分ではないかと推測いたします。 でわ m(_ _)m (隠居じーさん) 2019/01/20(日) 19:45
お世話になります。
>違っていればマクロコードのシート名を実際のシート名に変えて下さいね。
申し訳ありませんでした。シート名が間違っていました。
シート名を変更し操作しましたが、うまく操作しませんでした。
新しく表を作り操作しましたが、もこな2様のコードをシートモジュールに貼り付けましたが、変化がありませんでした、どこを直せばよいのか分かりません。大変申し訳ありません。
隠居じーさん様のマクロを実行すると、J3にコードを入力すると、下記の表の様に商品データの項目が二行目に表示されます。C列は空白です。
申し訳ありませんが、引き続きご教授願えませんでしょうかm(__)m
A B C D J 1 2 商品名 形 空白 型式 3 ID番号入力
宜しくお願いします。
(Cou) 2019/01/20(日) 20:37
あ。。。はい。。。しらべてみます。 m(_ _)m
(隠居じーさん) 2019/01/20(日) 20:43
お世話になります。
> MyROW = Application.Match(MyRNG.Value, .Range("A:A"), False)を
MyROW = Application.Match(MyRNG.Value, .Range("b:b"), False)に変えれば行けました。
大変申し訳ありませんでした。
今回ご提示頂いたコードのどこを変更すれば、抽出列を変えられるのでしょうか、申し訳ありませんが、
ご教授願えませんでしょうか。m(__)m宜しくお願いします。
隠居じーさん様
お世話をお掛けし、大変申し訳ありません。
(Cou) 2019/01/20(日) 20:52
>今回ご提示頂いたコードのどこを変更すれば、抽出列を変えられるのでしょうか、申し訳ありませんが、
> ご教授願えませんでしょうか。m(__)m宜しくお願いします。
使っているのは、ワークシート関数のMatch関数です。
なので、ちょっと自力で調べて(ネット検索して)みましょう。
それでもわからければ改めて質問すればどなたか解説してくださると思いますよ。
(もこな2) 2019/01/20(日) 21:03
A B C D E F G H I J 1 商品名 型番 型式 備考 ID 2 3 りんご 1−111−1 G-11-1 11
こんばんは ^^ こちらでは上記のようになりますが。 2行目はIDが有りませんので何も表示されません ずれてはいませんが。 C列も表示されています。 シート名 商品データ の内容は合っていますでしょうか。 また 表示されている商品名と型式と入力したIDは合っていますでしょうか (隠居じーさん) 2019/01/20(日) 21:08
大変お世話になり有難うございました。
>【商品データ】シートでIDが書いてあるのってA列ですよね?
説明不足で申し訳ありません。IDはB列に入力しておりました。
>自力で調べて(ネット検索して)みましょう。
有難うございます。勉強します。
隠居じーさん様
大変申し訳ありませんでした。
>商品名と型式と入力したIDは合っていますでしょうか
間違っておりました。大変失礼いたしました。
改めて、隠居じーさん様 もなこ2様
本当に有難うございました。感謝感謝です。有難うございました。m(__)m
(Cou) 2019/01/20(日) 21:25
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.