• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：VBAでVLOOKUPを使用）

VBAでVLOOKUPを使用する方法

keithinの回答

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

Sheet1のシート名タブを右クリックしてコードの表示を開始する 今のマクロを綺麗に消去する 次のマクロをコピー貼り付ける private sub worksheet_change(byval Target as excel.range) 　if target.address <> "$F$4" then exit sub 　if target = "" then exit sub 　on error resume next 　with range("F5:F7") 　　.formula = "=VLOOKUP($F$4,List!$A$2:$E$100,ROW(F2),FALSE)" 　　.value = .value 　　.specialcells(xlcelltypeconstants, xlerrors).clearcontents 　end with end sub ファイルメニューから終了してエクセルに戻る Ｆ４にコードを記入する。

axizaft2000
質問者

お礼

keithinさん、回答ありがとうございます。 早速試してみましたところ、うまくいきました。 コードも簡潔になっているので、とても有難いです。 1行1行じっくり勉強させていただきます。 ありがとうございました。

この回答がついた質問に戻る
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • VBAでVLOOKUP関数を使う

    下記VBAでResultsを反映する（更新）するのは、 空白セルだけにするのは、どうすれば良いのでしょうか。 （※参考：http://myrtus21.com/blog/2007/06/vbavlookup.html） 1日かけてトライしていますが、打開できません。 どなたかご教授願います。 どうかよろしくお願いいたします。 Sub 在庫数検索() Dim SerchName As String Dim SerchArea As Range Dim Results As Variant '初期設定 Range("A2").Activate ItemCode = Range("A2").Value i = 0 '検索範囲の設定（ポイント1） Set SerchArea =Worksheets("シート2").Range("List1") '商品コードが空になったら終わり Do Until ItemCode = "" 'エラーになっても続行する（ポイント2-1） On Error Resume Next '商品コードに該当するデータを探し、Resultsに入れる ItemCode = ActiveCell.Offset(i, 0).Value Results =Application.WorksheetFunction.VLookup(ItemCode, SerchArea, 2, False) '該当するデータがないとエラーになるための処理、エラーなら空欄にする（ポイント2-2） If Err <> 0 Then Results = "" ActiveCell.Offset(i, 1) = Results i = i + 1 Loop End Sub

  • VBAでVLOOKUP関数を使う

    「在庫検索」に下記条件を追加するには、どうすれば良いのでしょうか。 1）G列が1500より大きければ Results = Application.WorksheetFunction.VLookup(ItemCode, SerchArea, 2, False) 2）G列が1500より小さければ Results = Application.WorksheetFunction.VLookup(ItemCode, SerchArea, 3, False) どちらの際も空白の条件、If ActiveCell.offset(i, 1).value = ""は残ります。 1）、2）とandを組み合わせる方法でチャレンジしたのですが、出来ませんでした。 ------------------------------------------------------------------------ 以下がベースの「在庫検索」です。 一度、質問して解決したのですが、更なる問題が発生してしまいました。 ご指導ください。 ------------------------------------------------------------------------ Sub 在庫数検索() Dim SerchName As String Dim SerchArea As Range Dim Results As Variant '初期設定 Range("A2").Activate ItemCode = Range("A2").Value i = 0 '検索範囲の設定（ポイント1） Set SerchArea =Worksheets("シート2").Range("List1") '商品コードが空になったら終わり Do Until ItemCode = "" If ActiveCell.offset(i, 1).value = "" Then '★1 On Error Resume Next ItemCode = ActiveCell.offset(i, 0).value Results = Application.WorksheetFunction.VLookup(ItemCode, SerchArea, 2, False) If Err <> 0 Then Results = "" ActiveCell.offset(i, 1) = Results End If '★1 i = i + 1 Loop

  • エクセルVBA　VLOOKUPについて

    エクセル　VBA初心者です。 関数でのVLOOKUPをVBAで作りたいのですが、上手くいきません。 あらかじめ、Sheet2の1から300行までに A列　 / B列 商品名 / 商品コード が入力されています。(名前の定義=商品コード) Sheet1にユーザーフォームを利用して、データを書き込んだ後、 B列に商品名が書き込まれると、 A列に商品コードが表示されるようにしたいと考えています。 A列に =IF(B2="","",VLOOKUP(B2,商品コード,2,FALSE)) と入力していたのですが、 VBAでIfを使って出来ないかと考えてみたのですが、 上手くいきませんでした。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sRow As Long Dim sColumn As Long sRow = ActiveCell.Row sColumn = ActiveCell.Column If Cells(sRow, 2).Value = True Then Cells(sRow, 1).Value = WorksheetFunction.VLookup(Cells(sRow2).Value, Worksheets("Sheet2").Range("A1:B300"), 2, False) ElseIf Cells(sRow, 2).Value = " " Then Cells(sRow, 1).Value = " " End If End Sub ご教授いただけないでしょうか？ エクセル2003 WindowsXP

  • VBAでChangeイベントを使いたい

    今エクセルで出納を作ってます。 シート1には　Ａ日付　Bコード　C金額　D　消費税区分　E　金額 F,G,H,Iにも同様に貸方科目を入れてます。 シート2にはAコードB科目を上から下にずっといれてます。 それで借方金額Ｃの金額をEに飛ばすこと VLOOKUPでＢのコードに対応する科目を表示すること 上記をChangeイベントでやりたいのですが、金額転記はうまくいったのですが、 VLOOKUPの方が標準モジュールではうまくいくものの、シートモジュールに移すとうまく 行きません。おそらく根本的な理解がかけてるからだと思います。 今の記述は下記 シート1に Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 5 Then Exit Sub Dim Cnt As Long For Cnt = 2 To 100 Range("I" & Cnt).Value = Range("E" & Cnt).Value Next Cnt If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 3 Then Exit Sub End Sub 標準モジュールに Option Explicit Sub 科目() Dim シート1 As Worksheet Dim シート2 As Worksheet Set シート1 = Worksheets("出納") Set シート2 = Worksheets("科目") Dim myR On Error GoTo ErrorHandler myR = Application.WorksheetFunction.VLookup(シート1.Range("B2"), シート　　　　　　　　　2.Range("A2:B87"), 2, False) シート1.Range("C2").Value = myR Exit Sub ErrorHandler: シート1.Range("C2").Value = "該当無し" End Sub 　大変素人な質問ですみませんが、ご回答いただけると嬉しいです。 　基礎の本やレファレンス本は見たのですが、標準モジュールでできること 　がなぜシートモジュールでできないかが全く分かりません。 　よかったらお教えください。

  • VBAでコードの編集が上手くいきません

    先日、ご回答頂いたコードを元に自分でいじっているのですが上手く行きません 自分が変更したコード シート1→シート名：変更箇所 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$C$40" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$42" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$44" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub シート2→シート名：リスト Private Sub worksheet_change(ByVal Target As Excel.Range) Dim i As Long, c As Long Dim h As Range, ha As Range Dim myDic As Object Set ha = Application.Intersect(Target, Range("A:C")) If ha Is Nothing Then Exit Sub Set ha = Application.Intersect(ha.EntireColumn, Range("1:1")) For Each h In ha Set myDic = CreateObject("Scripting.Dictionary") If h.Column = 1 Then c = 3 'A列→C列 If h.Column = 2 Then c = 4 'B列→D列 If h.Column = 3 Then c = 6 'C列→F列 On Error Resume Next For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row If Cells(i, h.Column) <> "" Then myDic.Add Cells(i, h.Column).Value, Cells(i, h.Column).Value End If Next i With Worksheets("変更箇所").Cells(40, c).EntireColumn.Validation .Delete .Add Type:=xlValidateList, Formula1:=Join(myDic.keys, ",") End With Set myDic = Nothing Next End Sub シート1において$C$40または$C$42または$C$44のいずれかを変更した場合 最後に変更したセルに対し、シート2にオートフィルタ―がかかる様にしたいと思っています。 試しにシート1を以下のように編集したところ、思った動作を行ったのですが $C$40または$C$42または$C$44のいずれかのセルを空白にすると エラーがでてしまいます。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub Then Exit Subをどう編集すれば上手く動作するでしょうか？

  • VBAの書き方を教えてください　3

    何度も申し訳ございません。 以前にもこちらで質問させて頂いている者です。 Sheet1のrange("A1")をVLOOKUPで検索後の文字を取得し、同じ名前のシートを検索し、さらにrange("A1000")をアクティブにしてここからコードをつなげて処理しています。 range("A1")の処理が終わったら、range("A2")の処理に入り、range("A3") range("A4")を続けて処理を行っているのですが、range("A4")でVLOOKUPの検索が空白の場合、On Error GoTo myErrorで次のrange("A5")の処理に入りますが、On Error Gotoは1回のみの処理しかできないみたいで、range("A５")が空白の場合、実行時エラー9が発生してしまいます。 教えて頂いたコードを解読し、On Error Resume Nextなどを使おうとしているのですが、上手くできません。 １から10まで質問しっぱなしなのですが、どなたかご協力を頂けないでしょうか。 とりあえず自分の必要なコードはある程度省いて、2つ分のみ記載します。 本来この後、10回同じ処理を行います。 よろしくお願い致します。 Private Sub 記帳_Click() 　On Error GoTo myError1 　Dim i As Long 　Dim myFlg As Boolean 　　 For i = 1 To worksheets.Count If worksheets(i).Name = Range("A1").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select 　　　ActiveCell.Offset(1, 0).Select 　 ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If myError1: On Error GoTo myError2 For i = 1 To worksheets.Count If worksheets(i).Name = Range("A2").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select ActiveCell.Offset(1, 0).Select 　 ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If End sub

  • VBAで教えて下さい。

    VBA初心者です。始めてから２，３週間です。 表を作りたいのですが、 顧客名のシートを１００枚ほど作り、シート１（シート１は検索シートにしたいので顧客名は無）のA1にクライアント名を入力したら入力した顧客名シートが出てくる様にしたいです。 参考書、ネット等をみて作成しましたがエラーが出ます。作動するにはどの様にしたら宜しいでしょうか？どうかお助け下さい。宜しくお願い致します。コードは下記です。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim myWSname As String, myworksheet As Worksheet myWSname = "i" myWSname = Worksheets("sheet2").Range("A1").Value For Each myworksheet In Worksheets If myworksheet.Name = mayWSname Then Worksheets("myWSname").Activate Exit Sub End If Next myworksheet End Sub

  • エクセル2010のvbaについて

    Sheet1に挿入したイメージ(ActiveX)をクリックすると数字が上がって 実行中にもう一度同じイメージをクリックすると止まるようにしたいのですが 数字が上がったまま止まりません（上限はあるのでオーバーフローはしません） Worksheet_SelectionChangeで（ActiveXのイメージがもう一回押されて） 選択セルが変わったら停止としたかったのですが反応しません イメージをクリック（実行）してもう一回押すとクリックしている間は止まりますが離すと再開されます コードにクリックされた回数がわかるようにしましたが増えません 説明が分かりにくかったら追記します 回答お願いします クラスモジュールのコード（イメージの名前によって少し処理を変えるためです） Private Sub myImg_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim i As Integer, a, b, C As POINTAPI, obj As OLEObject i = myImg.Index - 1 Call GetCursorPos(C) Set obj = ActiveWindow.RangeFromPoint(C.X, C.Y) b = Range("A1") Range("A1") = obj.Name Range("A2") = Range("A2") + 1　　　　'クリックされた回数が分かるようにするため追加 If Range("A2") = 2 Then Range("C1").Select End If Range("A3") = "B1" If obj.Name = 2 Then Range("A3") = "B3" Range(Range("A3")).Select End Sub Sheet1のコード Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Address <> Range(Range("A3")).Address Then Exit Sub Do While ActiveCell < Range("A4") * 100 If ActiveCell.Address <> Range(Range("A3")).Address Then Exit Do End If DoEvents ActiveCell = ActiveCell + 1 Loop End Sub

  • Excel VBA でVLookUPの質問

    教えてください。 Excel VBA でVLookUPを使用したいのですが 毎回シート名も数も変わります。 そのため、検索範囲 のシート名をセル値が取得したいのですが どうすればよいでしょうか？ 検索値　= AシートB列 検索範囲=BシートM列 書出し範囲=AシートU列 下記のコード作成しましたが ws = Worksheets("②価格集計").Range("U2").Value 検索用格納配列(i, 1) = "=VLOOKUP(B" & i + 1 & ",ws!A:M,13,0)" でエラーがでます。 他に方法があれば教えてください。 宜しくお願い致します。 Sub test() Dim 検索値 As Range '検索値 Dim 検索用格納配列 As Variant '検索用格納配列 Dim 出力範囲 As Range '出力範囲 Dim i As Long Dim 検索範囲 As Range Dim endrow As Long Dim ws As Worksheet endrow = Sheets("①SPOT売却明細貼付").Range("B" & Rows.Count).End(xlUp).Row Set 検索値 = Worksheets("②価格集計").Range("B3:B302") Set 出力範囲 = Worksheets("②価格集計").Range("U3:U302") ws = Worksheets("②価格集計").Range("U2").Value 検索範囲 = Worksheets(社名).Range("A:M") 検索用格納配列 = Range(検索値, 出力範囲) For i = 1 To endrow 検索用格納配列(i, 1) = "=VLOOKUP(B" & i + 1 & ",ws!A:M,13,0)" Next 出力範囲 = 検索用格納配列 End Sub

  • VBA 特定もセルに入力で実行

    下記のコードを実行した際は問題なく実行されるのですが これを特定のセルに値が入力された際に動かそうとするとエラーになってしまいます。 Sub PaintTargetCharacter() Dim FoundCell As Range, FoundCell2 As Range Dim Addr As String Dim Addr2 As String Dim SearchArea As Range Dim SearchArea2 As Range Application.ScreenUpdating = False ActiveCell.Interior.ColorIndex = 0 '検索対象範囲 Set SearchArea = Worksheets("Ｇ番情報").Range("AE6:BG6") '検索実行 Set FoundCell = SearchArea.Find(What:=ActiveCell.Offset(0, -1), LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) '検索文字列を含むセルがない場合は終了 If FoundCell Is Nothing Then Exit Sub Set SearchArea2 = Range(FoundCell.Offset(1, 0), FoundCell.Offset(33, 0)) Set FoundCell2 = SearchArea2.Find(What:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) If FoundCell2 Is Nothing Then Exit Sub FoundCell2.Copy Destination:=ActiveCell Application.ScreenUpdating = True End Sub 当然、特定のセルで値を入力後エンターキーを押すとアクティブセルは下に下がってしまうので Private Sub Worksheet_Change(ByVal Target As Excel.Range) Target.select Call PaintTargetCharacter End Sub としているのですが Set FoundCell = SearchArea.Find(What:=ActiveCell.Offset(0, -1), LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) の部分でエラーが起きてしまいます。 また停止してシートに戻るとセルのカーソル表示が消えてしまいます。 この現象はシートを閉じて再度開くと直りますが なにかエラーと関係しているのでしょうか？ 初心者なのでおかしな部分が多々あると思います。 ご指摘などあれば宜しくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する