[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロでVLOOKUPのような事』(はるお)
顧客リストから注文書へ顧客Noをキー郵便番号・住所・電話番号を転記するマクロを教えて下さい。
=============================================
顧客リスト.xls
sheet1
顧客No 郵便番号 住所 電話番号
1 123-4567 東京都・・・ 03-3333-4444
2
3
4
・
・
・
※順次増えます
=============================================
=============================================
注文書.xls
sheet1
顧客No 郵便番号 住所 電話番号
2
5
8
10
==============================================
このような形のExcelファイルが2つあります。
注文書には顧客Noのみ記載されているので、これをキーに顧客リストから
郵便番号、住所、電話番号を転記したいです。
VLOOKUPで出来るのですが、関数が全く分からない方から頼まれていちいち対応するのが大変なので、マクロのツールを作成し、自身でやっていただくのが目的です。
ツールは別のファイルとして、顧客リストと注文書と同じフォルダに保存する事を考えています。顧客リスト、注文書のファイル名、シート名は固定します。
顧客リストの顧客NOは随時増えるので最終行を特定する必要があります。
実施するマクロと実施結果を消去するマクロの2つを教えて頂けますでしょうか
宜しくお願いいたします。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
えっ、すみません、自分が面倒くさいからやってもらうためにマクロ組めって言ってます? それ全く同じことをこちらの方々は返せると思うんですけど、その自覚はお有りでしょうか……。
恐らく、VBAわかる方なんですよね? 作りかけでいいので、コード載せてみてもらえませんか。 こうしてみたけどわからないと、そういった内容の書き込みをお待ちしてます。 (参考の表も情報が全く足りないので一切作ってない完全丸投げ状態でも誰も作らないと思いますけど) (わをん) 2018/02/26(月) 15:26
(マナ) 2018/02/26(月) 15:53
以下、今わかる範囲での回答です。
>関数が全く分からない方から頼まれていちいち対応するのが大変なので、マクロのツールを作成し、自身でやっていただくのが目的です。
ツール動かして、”値”が入るようにしたいならその関数で得られた値をセット(ヒント:Valueプロパティ)するように作るべきですし、
ツール動かして、”数式”が入るようにしたいなら、関数をマクロで作ってあげて、セット(ヒント:Formulaプロパティ)すればいいですよね?
保存先なんかはどうにでもできますので、この際あとから考えても良さそうに思います。
>顧客リストの顧客NOは随時増えるので最終行を特定する必要があります。
そうですね。そうしましょう。
やり方がわからないのであれば、「VBA、最終行」なんていれてグーグル先生に聞けばものすごいたくさん見つかりますよ。
もっとも、私はめんどくさがりなので、VLOOKUP関数に列ごと渡しますけど・・・(100万超の行数になった今それはダメだろうというツッコミはあるでしょうけど。)
(もこな2) 2018/02/26(月) 16:50
質問内容が曖昧で申し訳ございません。丸投げをするつもりではなかったのですが、そのように感じられたのであれば大変失礼しました。
「Excel VBA vlookup」などでグッグって幾つかのコードを見たのですが、自分のやりたい事に上手く当てはめることが出来ず、こちらに質問させて頂いた次第です。
質問はヒントが頂ければと思い、かなり条件を端折ってしまいましたが、実際は下記のような条件です。
【顧客リスト】
ファイル名:コピーCust_Download_Excel.xls
シート名:Custome
【注文書】
ファイル名:UserEst_Download_2018.xls
シート名:UserEst
顧客リストのB3以下に顧客Noが入っています。
R,S,T,U,V列に郵便番号、住所、URL、電話番号、FAXが入っています。
注文書のA4以下に顧客Noが入っており、vlookupで顧客リストの顧客Noと合致した場合
郵便番号、住所、URL、電話番号、FAXを注文書のETからEX列に転記したい
転記と削除で以下コードを書いてみて、とりあえず動きました。
もっとここはこうしたほうが良いなどの点があれば、アドバイスをお願いします。
Sub 住所転記()
'ワークシートを定義
Dim Cust As Worksheet
Dim Est As Worksheet
Set Cust = Workbooks("コピーCust_Download_Excel.xls").Worksheets("Customer")
Set Est = Workbooks("UserEst_Download_2018.xls").Worksheets("UserEst")
'Custの最終行を特定
Dim Cust_maxRow As Long
Cust_maxRow = Cust.Cells(Rows.Count, 2).End(xlUp).Row
'Custの検索範囲を指定
Dim Cust_range As Range
Set Cust_range = Range(Cust.Cells(2, 2), Cust.Cells(Cust_maxRow, 22))
'Estの最終行を特定
Dim Est_maxRow As Long
Est_maxRow = Est.Cells(Rows.Count, 1).End(xlUp).Row
Dim Est_tmp As Long
Dim Est_str As String
For Est_tmp = 4 To Est_maxRow
Est_str = Est.Cells(Est_tmp, 1).Value
On Error Resume Next
Est.Cells(Est_tmp, 150).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 17, False)
Est.Cells(Est_tmp, 151).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 18, False)
Est.Cells(Est_tmp, 152).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 19, False)
Est.Cells(Est_tmp, 153).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 20, False)
Est.Cells(Est_tmp, 154).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 21, False)
Next
'項目名をコピー
Cust.Range("R2:V2").Copy Est.Range("ET3:EX3")
MsgBox "終了しました"
End Sub
Sub 住所削除()
Dim Est As Worksheet
Set Est = Workbooks("UserEst_Download_2018.xls").Worksheets("UserEst")
Est.Range("ET1:EX1").EntireColumn.Delete
MsgBox "終了しました"
End Sub
(はるお) 2018/02/27(火) 13:05
作成してみた下記のマクロですが、マクロの編集画面(緑の右▲)から実行すると実行できるのですが、
ファイルからAlt+F8でマクロの実行をすると
「実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーです」が表示されます
デバッグでこちらの行が表示されます
Cust_maxRow = Cust.Cells(Rows.Count, 2).End(xlUp).Row
(下記コードの該当に★をつけました)
何か書き方に問題があるのでしょうか?ご教示いただけると幸いです。
Sub 住所転記()
'ワークシートを定義
Dim Cust As Worksheet
Dim Est As Worksheet
Set Cust = Workbooks("コピーCust_Download_Excel.xls").Worksheets("Customer")
Set Est = Workbooks("UserEst_Download_2018.xls").Worksheets("UserEst")
'Custの最終行を特定
Dim Cust_maxRow As Long
★Cust_maxRow = Cust.Cells(Rows.Count, 2).End(xlUp).Row
'Custの検索範囲を指定
Dim Cust_range As Range
Set Cust_range = Range(Cust.Cells(2, 2), Cust.Cells(Cust_maxRow, 22))
'Estの最終行を特定
Dim Est_maxRow As Long
Est_maxRow = Est.Cells(Rows.Count, 1).End(xlUp).Row
Dim Est_tmp As Long
Dim Est_str As String
For Est_tmp = 4 To Est_maxRow
Est_str = Est.Cells(Est_tmp, 1).Value
On Error Resume Next
Est.Cells(Est_tmp, 150).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 17, False)
Est.Cells(Est_tmp, 151).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 18, False)
Est.Cells(Est_tmp, 152).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 19, False)
Est.Cells(Est_tmp, 153).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 20, False)
Est.Cells(Est_tmp, 154).Value = Application.WorksheetFunction.vlookup(Est_str, Cust_range, 21, False)
Next
'項目名をコピー
Cust.Range("R2:V2").Copy Est.Range("ET3:EX3")
MsgBox "終了しました"
End Sub
(はるお) 2018/02/27(火) 15:58
とりあえず、データ量が可変であるときに先に数式を仕込んでおくことが困難なので、
データ範囲が可変であることに対応したマクロを仕込んで配布すれば、
なんとか使ってもらえるのではないかということで、
マクロを書きたいのですね。
名前の定義を使えばマスターのリストの増減には対応できますし、
編集している表に数式を追加するなら、フィルハンドルダブルクリックで、
数式コピーは簡単かと思いますが。。。マクロでなのですね。
>ファイルからAlt+F8でマクロの実行をすると
>「実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーです」が
>表示されます
こちらの原因は解りかねます(データ等を同じ配置にしないと再現が難しい?)が、
以下のマクロではいかがでしょうか?(セル範囲のズレはそちらで修正願います。)
Sub test()
Dim rngList As Range Dim rngTable As Range
Set rngList = Workbooks("コピーCust_Download_Excel.xls").Worksheets("Customer").Range("A1").CurrentRegion
With Workbooks("UserEst_Download_2018.xls").Worksheets("UserEst").Range("A1").CurrentRegion Set rngTable = Intersect(.Cells, .Offset(1)) End With
With rngTable.Columns("ET:EX") .Columns(1).Formula = "=VLOOKUP(" & rngList(1).Address & "," & rngTable.Address & ",17,0)" .Columns(2).Formula = "=VLOOKUP(" & rngList(1).Address & "," & rngTable.Address & ",18,0)" .Columns(3).Formula = "=VLOOKUP(" & rngList(1).Address & "," & rngTable.Address & ",19,0)" .Columns(4).Formula = "=VLOOKUP(" & rngList(1).Address & "," & rngTable.Address & ",20,0)" .Columns(5).Formula = "=VLOOKUP(" & rngList(1).Address & "," & rngTable.Address & ",21,0)" .Value = .Value End With End Sub (まっつわん) 2018/02/27(火) 16:29
マクロにこだわる理由としては、顧客リスト、注文書、共に毎回DBからエクスポートしたものを使用する為、ファイルに組み込めない為です。
ご提示頂いたコードはちょっと私のレベルでは解読に時間が掛かりそうなので、後ほどジックリ拝見させて頂きます。
まずは取り急ぎ御礼まで。
(はるお) 2018/02/27(火) 16:56
Sub 住所転記を整理()
'==変数の宣言など
'ワークシートを定義 Dim Cust As Worksheet Set Cust = Workbooks("コピーCust_Download_Excel.xls").Worksheets("Customer") Dim Est As Worksheet Set Est = Workbooks("UserEst_Download_2018.xls").Worksheets("UserEst")
'Custの最終行を特定 Dim Cust_maxRow As Long Cust_maxRow = Cust.Cells(Cust.Rows.Count, 2).End(xlUp).Row
'Custの検索範囲を指定 Dim Cust_range As Range Set Cust_range = Range(Cust.Cells(2, 2), Cust.Cells(Cust_maxRow, 22))
'Estの対象行を定義 Dim Est_tmp As Long
'ワークシート関数をオブジェクト化 Dim WF As Object Set WF = Application.WorksheetFunction
'==処理
On Error Resume Next
With Est For Est_tmp = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row .Cells(Est_tmp, 150).Value = _ WF.VLookup(.Cells(Est_tmp, "A").Value, Cust_range, 17, False) '郵便番号 .Cells(Est_tmp, 151).Value = _ WF.VLookup(.Cells(Est_tmp, "A").Value, Cust_range, 18, False) '住所 .Cells(Est_tmp, 152).Value = _ WF.VLookup(.Cells(Est_tmp, "A").Value, Cust_range, 19, False) 'URL .Cells(Est_tmp, 153).Value = _ WF.VLookup(.Cells(Est_tmp, "A").Value, Cust_range, 20, False) '電話番号 .Cells(Est_tmp, 154).Value = _ WF.VLookup(.Cells(Est_tmp, "A").Value, Cust_range, 21, False) 'FAX Next Est_tmp
'項目名をコピー Cust.Range("R2:V2").Copy .Range("ET3:EX3") End With
MsgBox "終了しました" End Sub
エラーのほうは、たぶんですが
Cust_maxRow = Cust.Cells(Rows.Count, 2).End(xlUp).Row
↓
Cust_maxRow = Cust.Cells(Cust.Rows.Count, 2).End(xlUp).Row
こう直せばいいとおもいます。
(1,048,576行あるシートがアクティブになってるときに、マクロを実行したと想像)
また、消去するマクロというのはイメージがよくわかりません。
Noがブランクになったらクリアすればいいんでしょうか?
その場合は、正攻法でいくなら、シートイベントでなんとかするんでしょうけど、数式を仕込めないと仰るブックに、マクロを仕込むということは当然できないでしょうから、他のブックからシートイベントを掴む必要があるってことですよね?ちょっと私のスキルだと、その部分はわかりません。
(もこな2) 2018/02/28(水) 01:02
早速教えて頂いた事を試してみたいのですが、来週まで試せる環境に居ないので
後日検証させていただきます。
消去マクロは住所転記した列を丸ごと消去する為のものです。
何でそんなものが必要か?というと、転記したままでDBにインポートするとエラーになるので、作ってみました。
列選択して削除するだけなのですが、それすらやらないユーザーの為の保険なので必須ではありません。
以上、取り急ぎ御礼まで
(はるお) 2018/02/28(水) 07:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.