『マクロでVLOOKUPのような事』（はるお）

顧客リストから注文書へ顧客Noをキー郵便番号・住所・電話番号を転記するマクロを教えて下さい。

=============================================
顧客リスト.xls
sheet1

顧客No　郵便番号　住所　　　　　電話番号
１　　　123-4567　東京都・・・　03-3333-4444
２
３
４
・
・
・
※順次増えます
=============================================

=============================================
注文書.xls
sheet1
顧客No　郵便番号　住所　電話番号
２
５
８
１０
==============================================
このような形のExcelファイルが２つあります。

注文書には顧客Noのみ記載されているので、これをキーに顧客リストから
郵便番号、住所、電話番号を転記したいです。
VLOOKUPで出来るのですが、関数が全く分からない方から頼まれていちいち対応するのが大変なので、マクロのツールを作成し、自身でやっていただくのが目的です。

ツールは別のファイルとして、顧客リストと注文書と同じフォルダに保存する事を考えています。顧客リスト、注文書のファイル名、シート名は固定します。

顧客リストの顧客NOは随時増えるので最終行を特定する必要があります。

実施するマクロと実施結果を消去するマクロの２つを教えて頂けますでしょうか
宜しくお願いいたします。



＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
----
 えっ、すみません、自分が面倒くさいからやってもらうためにマクロ組めって言ってます？
 それ全く同じことをこちらの方々は返せると思うんですけど、その自覚はお有りでしょうか……。
 
 恐らく、VBAわかる方なんですよね？　作りかけでいいので、コード載せてみてもらえませんか。
 こうしてみたけどわからないと、そういった内容の書き込みをお待ちしてます。
 (参考の表も情報が全く足りないので一切作ってない完全丸投げ状態でも誰も作らないと思いますけど)
（わをん） 2018/02/26(月) 15:26
----
VLOOKUPの式を予め想定される最大行数分セットしておいて
シート保護で編集できないようにしておけばよいのでは？

（マナ） 2018/02/26(月) 15:53
----
わをんさんとほぼ同じことですけど、
わからないところがわからず、回答者にそれがわかるかわからないので、アドバイスできません。
具体的にどこがわからないとか、どのようになると思って、どうしたら、どのようになってしまったのかなどの情報が不足しています。

以下、今わかる範囲での回答です。

＞関数が全く分からない方から頼まれていちいち対応するのが大変なので、マクロのツールを作成し、自身でやっていただくのが目的です。
ツール動かして、”値”が入るようにしたいならその関数で得られた値をセット（ヒント：Valueプロパティ）するように作るべきですし、
ツール動かして、”数式”が入るようにしたいなら、関数をマクロで作ってあげて、セット（ヒント：Formulaプロパティ）すればいいですよね？
保存先なんかはどうにでもできますので、この際あとから考えても良さそうに思います。

＞顧客リストの顧客NOは随時増えるので最終行を特定する必要があります。
そうですね。そうしましょう。
やり方がわからないのであれば、「VBA、最終行」なんていれてグーグル先生に聞けばものすごいたくさん見つかりますよ。
もっとも、私はめんどくさがりなので、VLOOKUP関数に列ごと渡しますけど・・・（100万超の行数になった今それはダメだろうというツッコミはあるでしょうけど。）
（もこな２） 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がブランクになったらクリアすればいいんでしょうか？
その場合は、正攻法でいくなら、シートイベントでなんとかするんでしょうけど、数式を仕込めないと仰るブックに、マクロを仕込むということは当然できないでしょうから、他のブックからシートイベントを掴む必要があるってことですよね？ちょっと私のスキルだと、その部分はわかりません。
（もこな２） 2018/02/28(水) 01:02
----
もこな2様
ご回答頂きありがとうございます。
確かに思いつくままに書いていたので見づらいですね(反省)
もこな2様に整理頂いたのを拝見し勉強になりました。

早速教えて頂いた事を試してみたいのですが、来週まで試せる環境に居ないので
後日検証させていただきます。

消去マクロは住所転記した列を丸ごと消去する為のものです。
何でそんなものが必要か？というと、転記したままでDBにインポートするとエラーになるので、作ってみました。
列選択して削除するだけなのですが、それすらやらないユーザーの為の保険なので必須ではありません。

以上、取り急ぎ御礼まで
（はるお） 2018/02/28(水) 07:46