• ベストアンサー

エクセルで複数列の検索をマクロで行いたい

A列、B列、C列に項目が、D列以降にデータが入っているシートがあります。 具体的には、  A列:商品名  B列:地域名  C列:店舗名 となっていて、ABCの順で昇順にソートがかけられています。 マクロの記録を使って一行だけを検索することは出来たのですが、(Selection.find(What:="商品名"~ となっていました)本当は、"商品名"+"地域名"+"店舗名"が一致するものを検索したいのです。 現在は、一行目で検索をかけて、後はactivecell.offset(*,*).value="地域名"のような感じで、しらみつぶしに探しています。 複数列で検索するよい方法などありましたら教えてください。

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

#2 のWendy02 です。 後で、ミスを見つけましたので、こちらを優先させてください。見つからない場合のことを忘れていませした。(^^; Sub Sample() Dim nm As Variant Dim buf As Variant, i As Long Dim Rng As Range With ActiveSheet Set Rng = .Range("A1").CurrentRegion .Range("A1:C1").Copy .Range("AA1") For Each nm In Array("商品名", "地域名", "店舗名")   Do   buf = Application.InputBox(nm & "を入れてください。", Type:=2)   If VarType(buf) = vbBoolean Then Exit Sub   If buf = "" Then MsgBox nm & "を入れてください。"   Loop While buf = ""   .Range("AA2").Offset(, i).Value = buf   i = i + 1 Next nm         Rng.AdvancedFilter _          Action:=xlFilterInPlace, _          CriteriaRange:=.Range("AA1:AC2"), _          Unique:=False     On Error Resume Next   Rng.Offset(1).Resize(Rng.Rows.Count - 1). _   SpecialCells(xlCellTypeVisible).Select   If Err.Number > 0 Then    MsgBox "探しているものは見つかりません", vbCritical   Else    .ShowAllData   End If   On Error GoTo 0 End With   Set Rng = Nothing   Range("Criteria").ClearContents End Sub

MONAKA2003
質問者

お礼

ありがとうございます。 知りたかった内容以外にも勉強になりました。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

本来は、Find メソッドよりも、オートフィルターやフィルターオプションのほうがよいのでは?以下のようなものでダメなら、また、別のものを考えます。 Sub Sample() Dim nm As Variant Dim buf As Variant, i As Long Dim Rng As Range With ActiveSheet Set Rng = .Range("A1").CurrentRegion  .Range("A1:C1").Copy .Range("AA1") For Each nm In Array("商品名", "地域名", "店舗名")   Do   buf = Application.InputBox(nm & "を入れてください。", Type:=2)   If VarType(buf) = vbBoolean Then Exit Sub   If buf = "" Then MsgBox nm & "を入れてください。"   Loop While buf = ""   .Range("AA2").Offset(, i).Value = buf   i = i + 1 Next nm         Rng.AdvancedFilter _          Action:=xlFilterInPlace, _          CriteriaRange:=.Range("AA1:AC2"), _          Unique:=False     Rng.Offset(1).Resize(Rng.Rows.Count - 1). _   SpecialCells(xlCellTypeVisible).Select   .ShowAllData End With   Set Rng = Nothing   Range("Criteria").ClearContents End Sub

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.1

検索(Find)で探せるのは1つの項目です。 複数列の条件の場合は、オートフィルタを使うしかありません。

参考URL:
http://www.officetanaka.net/excel/vba/db/index.htm
MONAKA2003
質問者

お礼

ありがとうございます。 オートフィルタをうまく使えるようにしてみます。

関連するQ&A

  • EXCELのマクロについて

    お世話になっております。 以下のマクロを1万行分繰り返したいのですが、回数を1万回と指定する構文を 教えてください。よろしくお願いします。 Sub Macro16() ' ' Macro16 Macro ' ' Keyboard Shortcut: Ctrl+Shift+Z ' ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ActiveCell.Offset(-1, 0).Range("A1:M1").Select Selection.Copy ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste ActiveCell.Offset(-1, 2).Range("A1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "7/5/1905" ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.FormulaR1C1 = "7/6/1905" ActiveCell.Offset(1, -2).Range("A1").Select End Sub

  • エクセルで検索と貼り付けのマクロを組みたい

    エクセルで次のようなマクロを組みたいのですがうまくいきません。 ・C5からBB6の範囲において、Aという文字が入っているセルを検索し、その4行下1列右にコピーしておいたものを値だけ貼り付ける。 検索範囲を指定したいのは同じシート内に他にもAという文字が入っているセルがあるからです。このマクロを実行すると何故かC5からBB6の範囲以外のセルを選択し、貼り付けてしまいます。どこがいけないのでしょうか。ぜひ、教えてください。お願いします。 Range("C5:BB6").Select Cells.Find(What:="A", After:=ActiveCell, LookIn:=xlValues,LookAt:= _ xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _False, MatchByte:=False, SearchFormat:=False).select Selection.Offset(4, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False

  • エクセルのマクロ検索について

    みなさんはじめまして。 先日より必要に駆られてエクセルのマクロを使い始めた初心者です。 なかなか独学ではうまくいかず、 皆さんのお知恵を拝借したくお願いします。 したいことは以下の通りです。 検索シートに検索会社を入力すると、一部でも一致するデータを 顧客データが入った別シートから検索し、 検索シートにリストアップすると言うことがしたいです。 データシートには  A列  B列   C列   D列    E列     F列  分類  会社名  担当者  電話番号 詳細へハイパーリンク 業務内容  ----  ●社   Aさん  123-4567  ******    XXXX  ----  ×社   Bさん  234-5678  ******    ????  ----  △社   Cさん  345-6789  ******    !!!!! などのようにデータが300社くらい入っています。 一応自分で下記のようなマクロを組んでみたのですが、 リストアップされたデータのハイパーリンクの部分が文字列になってリンクとして使えません。 解消方法、またはもっと良いマクロがあれば教示お願いします Sub 検索() Dim tmp As Range Dim y As Integer, a, firstAddress '***** 結果を表示する部分をクリアします Sheets("検索").Range("A7:ag65536").ClearContents '***** キーワードを取得 a = InputBox("検索会社名を入力してください") '***** キーワードを含むデータを検索 Set tmp = Sheets("検索元データ").Columns(3).Find(a, , , xlPart) If tmp Is Nothing Then '***** 見つからない場合 MsgBox "一致するデータはありません" Else '***** 見つかった場合 firstAddress = tmp.Address y = 7 '***** 他にもあるか探してあれば記載 Do Sheets("検索").Range("c" & y) = tmp Sheets("検索").Range("b" & y) = tmp.Offset(0, -1) Sheets("検索").Range("d" & y) = tmp.Offset(0, 1) Sheets("検索").Range("e" & y) = tmp.Offset(0, 2) Sheets("検索").Range("f" & y) = tmp.Offset(0, 3) Sheets("検索").Range("g" & y) = tmp.Offset(0, 4) Sheets("検索").Range("h" & y) = tmp.Offset(0, 5) Sheets("検索").Range("i" & y) = tmp.Offset(0, 6) Sheets("検索").Range("j" & y) = tmp.Offset(0, 7) Set tmp = Sheets("検索元データ").Columns(3).FindNext(tmp) y = y + 1 Loop Until tmp.Address = firstAddress End If End Sub

  • エクセル マクロ 数式を入れたい!!

    超初心者です。よろしくお願いします。 A1に時間が入っており、B1にA1の6時間前(=A1+1-"06:00")の時間を入れたいです。日付は無視しており、アクティブセルはC1です。 時間ではなく、数式(=A1+1-"06:00")をそのままB1に入れたいのですがこのようになってしまいました。 ActiveCell.Offset(0, -1) = "=ActiveCell.Offset(0, -2)+1-"06:00"" 文字が赤くなってエラーになってしまうのですが、どこを訂正するべきでしょうか。

  • エクセルで画像の挿入マクロについて

    エクセルのB列にJANコードが入力してあり、 (1)セル内容コピー  (2)C列にそのJANコード.emfのファイル名画像を挿入 (3)次の行に移る この作業をマクロ記録してみたところ内容が下記の様になりました。 Sub JAN() ' ' JAN Macro ' ' Keyboard Shortcut: Ctrl+Shift+Q ' Selection.Copy ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Pictures.Insert( _ "C:\Users\user\Documents\JAN_バーコード\1234567890123.emf").Select ActiveCell.Offset(1, -1).Range("A1").Select End Sub 挿入する画像のファイル名が最初のものに固定されてしまっているのですが、 これを次のセル内容に自動で変える為にはどうすればよいでしょうか。

  • エクセル マクロ VBA について

    以下はセルB2.C2.D2.E2.F2をアクティブセルから右方向へ入力しています。ここでの入力とは"=" + "セルB2" というものです。一つずつ入力している為マクロが長くなります。短くシンプルなものにしたいです。ご教示お願いします。 ActiveCell.FormulaR1C1 = "=R2C2" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=R2C3" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=R2C4" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=R2C5" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=R2C6"

  • excel VBAの検索マクロを、OOo CALCで動かしたいのですが

    excel VBAの検索マクロを、OOo CALCで動かしたいのですが、、、 お助けください。VBA素人で、OOo BASICは全くわからない者です。よろしくおねがいします。 シート1を検索データの入力及び検索結果の表示画面として使い、 シート2に検索先のデータが入力されています。 検索先のデータは乱雑に入力されており、探したいデータが複数の列に点在し、 かつ、ひとつのセルにふたつのデータが入っていることもあります。 部分一致検索で、EXCELの検索機能の「次を検索」ボタンと同じ機能を果たすように作ったつもりです。 データが見つかった場合、シート2のデータをシート1にコピーするようになっています。 ソフトウェアのバージョンはcalc2.0と3.0です。 Excelでは動いているのですが、どう変えればcalcで使えるようになりますでしょうか? --------------------------------------------- Sub kensaku() 'sheet1のC4に検索したいデータを入力済 Dim A Set A = Range("sheet1!C4") Dim B As Range 'シート2を選択。 Sheets("sheet2").Select 'A1:S800の範囲をAの値で検索。 Set B = Range("A1:S800").Find(What:=A, _ after:=ActiveCell, SearchDirection:=xlNext, _ LookAt:=xlPart, MatchCase:=False, _ MatchByte:=False, SearchFormat:=False) '分岐 '見つからなかった場合、シート1の関数参照先のセルをクリアしてリセット。 If B Is Nothing Then MsgBox "見つかりません" Sheets("sheet1").Select Range("C2").ClearContents '見つかった場合、処理を続行する。 Else B.Activate 'A列へ移動。場合により空白セルを超える必要があるため10回繰り返す。 Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select 'A列からC列へ移動すると目的のデータが入った列に到達。 Selection.Offset(0, 2).Select 'その値をコピーしてシート1のC2へ貼付(関数の参照先) Selection.Copy Sheets("sheet1").Select Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '範囲選択を解除 Application.CutCopyMode = False 'sheet2のアクティブセルを次の検索開始位置(16列右)へ移動 (条件に一致する次のデータを検索するため) Sheets("sheet2").Select Selection.Offset(0, 16).Select 'シート1に戻る Sheets("sheet1").Select End If End Sub

  • エクセルマクロについて

    最終行の1つ下の行に100000と入力したいですが Range("b65536").Select Selection.End(xlUp).Select ActiveCell.Offset(0, 1).Value = 100000 としてもうまく行きません Selection.End(xlUp).Select この部分だけで なんとかなるのでしょうか よろしくお願い致します

  • マクロ:セルの範囲指定

    エクセルマクロで困っています。 セルの範囲指定をしようとしています。 初心者過ぎて、よくわかりません。 現在のマクロ↓ Sub 済() If ActiveCell.Column = 21 Then Selection.FormatConditions.Delete '条件付き書式削除 With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With '色変え判定セル書き換え ActiveCell.Offset(0, 5).Select ActiveCell.FormulaR1C1 = "77" ActiveCell.Offset(0, -5).Select Else answer = MsgBox("U列を選択して下さい", vbCritical) End If End Sub やりたい事は、下記の通りです。 列Uがアクティブの時にU~ACの行を塗りつぶし。 列は変動します。 今は、やり方がよく分からなかったため オフセットで一つ一つ塗りつぶしてます。 マクロを組みすぎてファイルが重くなって困っています。 回答よろしくお願いいたします。

  • エクセル一覧表からの検索

    商品管理に使いたいのですが、例えばA列に商品NO.B列に商品名、C列にメーカー名・・・といった一覧表から↓  A        B       C     D  商品NO.  商品名  メーカー名  棚NO. 0001    オシエテ   goo     A-1 0002    コタエテ    net     A-2 vlookup関数で商品NO.(A列)を入力し、商品名(B列)を検索する数式はわかったんですが、同時にメーカー名(C列)棚NO.(D列)も表示したいんですがどんな方法があるでしょうか?(現在、0001入力でオシエテは検索できるがgoo A-1が出ない。当たり前だけど) また、B入力で他のA C DさらにC入力でA B Dが一発で検索できるようにしたいのですが何か良い方法はありませんか?よろしくお願いします。

専門家に質問してみよう