- ベストアンサー
Application.Matchについて
- A1と同じものを検索するのにApplication.MatchとForNextを使って行いたいが上手くできない
- マクロを実行すると一番最初のデータしか取得できないが、全てのデータを検索したい
- どうしたら良いか教えてください
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (2)
- web2525
- ベストアンサー率42% (1219/2850)
>ForNextを使って行いたい ならば、こんなかんじかな？ Sub Sample3() Dim ret As Variant For i = 1 To 10 If Cells(1, 1) = Cells(i, 2) Then ret = ret & i & vbCrLf End If Cells(2, 5) = ret Next If ret = "" Then MsgBox "該当データが見つかりません" Else MsgBox ret & "番めのデータです" End If End Sub
補足
早々ありがとうございました。 >ForNextを使って行いたいならば、こんなかんじかな？ですがこれ以外にApplication.WorksheetFunctionなんかを使用してできますか？ ForNextでは遅いのではと思っています。 実際には沢山の中から検索したいのでできるだけ早いほうが助かります。 再度よろしくお願いします。
- web2525
- ベストアンサー率42% (1219/2850)
関連するQ&A
- DTPickerで入力したらの検索が出来なくなりました。
お世話になります。 質問ですが 以下のVBAコードがあります。Sheet3のCells(2, 6)に記入した日付によってSheet1の検索を一部行うのですが、Cells(2, 6)への入力をDTPickerを使って行うようにしたら該当する日付がありませんのエラーが帰ってきます。たぶん書式が違うせいかなと思うのですがどうすればいいのでしょうか？ どなたか分かる方いらっしゃいますか？よろしくお願いします。 Private Sub CommandButton1_Click() Dim trgA As Variant, trgB As Variant With Worksheets("Sheet3") If IsEmpty(.Cells(2, 7)) Then MsgBox "個数が空です。", vbCritical: Exit Sub '日付 trgA = Application.Match(.Cells(2, 6).Value2, Worksheets("Sheet1").Range("A:A"), 0) If IsError(trgA) Then MsgBox "該当する日付がありません。", vbCritical: Exit Sub '製品名 trgB = Application.Match(.Cells(2, 4).Value, Worksheets("Sheet1").Range("2:2"), 0) If IsError(trgB) Then MsgBox "該当する製品名がありません。", vbCritical: Exit Sub If Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = "" Then Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = .Cells(2, 7).Value Else If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then Worksheets("Sheet1").Cells(trgA, trgB + 1).Value = .Cells(2, 7).Value End If End If End With End Sub
- 締切済み
- オフィス系ソフト
- Ｍａｔｃｈ関数がうまく機能していない？？
すみません。また教えて下さい。 過去ログを見てシート１にあったデータをシート４にあるデータと照らし合わせてすでにあれば書き換え、なければ追加というようにできるようにしたく過去ログを参考にしてやったのですが、どうしてもエラーが出てしまいます。 Private Sub aa() Dim intlastrow1 As Integer Dim strb As String Dim longlastrow1 As Long intlastrow1 = Sheets(1).Range("A7").End(xlDown).Row longlastrow1 = Sheets(4).Range("A1").End(xlDown).Row Dim c As Object Dim rtn As Variant Dim d As Integer With Sheets(4) .Select For Each c In .Range("A1", "A" & longlastrow1) rtn = Application.Match(c.Value, Sheets(1).Range("A7:A" & intlastrow1), 0) d = c.Row strb = Cells(d, "A").Value If IsError(rtn) Then With Sheets(4).Cells(longlastrow1 + 1, "A") .Value = strb With .Font .Name = "ＭＳ Ｐゴシック" .Bold = False .Size = 8 End With End With Sheets(4).Cells(longlastrow1 + 1, "B").Value = Sheets(1).Range("A2").Value Sheets(4).Cells(longlastrow1 + 1, "F").Value = ShowFormula(Sheet1.Range(Cells(d, "J"), Cells(d, "N"))) longlastrow1 = longlastrow1 + 1 End If If Not IsError(rtn) Then Exit Sub End If Next c End With End Sub 以上のように組んだのですがうまくいきません。 具体的に言うとシート１のＡ７よりしたに名前が並んでいる（山田、鈴木・・・）とお考え下さい（シート４のＡ２以下にも同様に名前が並んでいる）。字数の関係で判定後の処理が不十分になっています。
- ベストアンサー
- オフィス系ソフト
- Matchで戻ってきた値をハイパーリンクのセル指定に使う方法
ActiveSheetに入力した時、入力値と同じ値を同ブックの2つのシートから検索してハイパーリンクを設定したいです。 Matchを使ってリンクさせたいセルの行番号を取得したつもりなのですが、リンク設置の際にどのような使い方をすればいいのか分からないので教えてほしいです。 下記コードでは、入力した値が青文字になりリンクされたようになりますが、クリックすると「このワークシートの数式に、1つまたは複数の無効な参照が含まれています。有効なパス、ブック、範囲名およびセル参照が数式に含まれていることを確認してください。」とでます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim kennsaku, y, z Set y = Worksheets("データ").Range("$C$4:$C$1003") Set z = Worksheets("データ2").Range("$A$2:$A$65536") kennsaku = Application.Match(Target.Value, y, 0) If IsNumeric(kennsaku) Then ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!range(cells(kennsaku,3))" Else kennsaku = Application.Match(Target.Value, z, 0) If IsError(kennsaku) Then MsgBox "見つからないのでリンクは貼りません", vbOKOnly + vbExclamation Exit Sub Else ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ2 & "'!range(cells(kennsaku,1))" End If End If End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡを教えて下さい
エクセルの表で －ＡＢ Ｃ Ｄ Ｅ Ｆ １年月－－1801 ２－－－－－－ ３－－－－－－ ４－－－－－－ （－）は空欄でセルＥ１＝１８、Ｆ１＝１とします。 コントロールボックスをつかって Private Sub Command登録_Click() Dim d1 As Long Dim d2 As Long Dim ret As Variant Dim FindValue As String Dim TotalAddress As String If Range("E1").Value = "" Or Range("F1").Value = "" Then MsgBox "該当する場所にデータが入っていません。", vbCritical Exit Sub End If d1 = Range("A65536").End(xlUp).Offset(1).Row d2 = Range("B65536").End(xlUp).Offset(1).Row FindValue = """" & Range("E1").Value & Range("F1").Value & """" TotalAddress = Range("A1").Resize(d1).Address & "&" & Range("B1").Resize(d1).Address ret = Evaluate("MATCH(" & FindValue & "," & TotalAddress & ",0)") If IsError(ret) Then Cells(d1, 1) = Range("E1").Value Cells(d2, 2) = Range("F1").Value Else MsgBox "既に同じ組み合せがあります。", vbInformation End If End Sub というものを作ったのですが、Ｅ１＝１８、Ｆ１＝１及びコマンドボタンを別シートに作成し、上記の表への登録をできるようにしたいのですが、なにかいい方法はありませんか？
- ベストアンサー
- オフィス系ソフト
- Matchの処理について
下記の処理がどうしてもうまくいかなくて、 皆様のお知恵を拝借できればありがたいです。 Sheet1に下記のように縦に３列データがならんでいます。 A あ 10 A い 12 A う 16 B あ 19 B い 15 B う 7 これをもとにSheet2に下記の通りマトリクス形式に 変換する。 あ い う A 10 12 16 B 19 15 7 これを処理しようと以下の通り記述したのですが、 マッチする項目がなかった場合、どうも行（列）が ずれてヒットしているようです。 On Error Resume Nextが原因のような気がするのですが。 これを回避するにはどうしたらよろしいでしょうか？ お助けください～。 よろしくお願い致します。 Dim i As Long Dim j As Long Dim k As Long Dim 検索値A As Variant Dim 検索値B As Variant On Error Resume Next i = 2 Do While (Sheets("SHEET1").Cells(i, 1) <> "") 検索値A = Sheets("SHEET1").Cells(i, 1).Value 検索値B = Sheets("SHEET1").Cells(i, 2).Value j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0) k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0) Sheets("Sheet2").Cells(j, k).Value =Sheets("SHEET1").Cells(i, 3) i = i + 1 Loop End Sub
- ベストアンサー
- Visual Basic
- VBAでVlookup機能を使うときにエラー
このコミュニティでもたびたび質問されているVLOOKUPのVBAですが 解答例で多く書かれているのが Public Sub test() Dim MyVariant As Variant MyVariant = Application.VLookup("excel", Range("A:B"), 2, False) If IsError(MyVariant) Then Debug.Print "Not Found" Else Debug.Print MyVariant End If End Sub なのですがRangeの部分にシートの情報を乗せるとエラーが出ます 例）Application.VLookup(Label6.Caption, WorkSheets("Sheet5").Range("A:B"), 2, False) まだまだ初心者なので何がおかしいのかわかりません よろしくお願いします
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ Matchの使い方
前回の質問で、大変親切に回答して頂き、大変感謝しております。 でも、私自身がこの質問サイトのルールを把握していなっかたので、まだ問題が解決していないのに、親切に回答してくださった方を、ベストアンサーに選んでしまいました。 でも、まだ問題が解決していないので、再度質問をさせて頂きます。 私のやりたい事は下記のような事です。 現金出納帳シートのA列（大科目）B列（小科目）の文字列の中の 大科目（たとえば会費・入会金）小科目（たとえば会費） この二つの文字が、決算シートのA列（大科目）の範囲のB列（小科目）の同じ文字と一致したときに 現金出納帳シートのB列（小科目）の一致した文字の行の4列目の数値を決算シートのB列（小科目）の同じ文字の行の右隣のセルに、出納帳に入力した数値を入れたいのです。 前回の回答を参考に、下記のようなマクロを試してみたのですがどうしてもうまくいくません。 Dim s Dim h As Variant Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Range("B3:B103").Value For Each ws In Worksheets s = ws.Index Next ws For K = 5 To s Step 1 Set KaMoku = Sheets(K).Range("D3:J103").Columns(1) Next K If IsError(Application.Match(h, KaMoku, 0)) = False Then この用にするとここでエラーになります。 MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) 実行時エラー方が一致しません MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) N = N + MyUNo Sheets("決算").Cells(3, 5).Value = N End If End Sub もう一例 Dim s Dim h As Variant Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Range("B3:B103").Value For Each ws In Worksheets s = ws.Index Next ws For K = 5 To s Step 1 Set KaMoku = Sheets(K).Range("D3:J103").Columns(1) Next K If IsError(Application.Match(h, KaMoku, 0)) = False Then では、.WorksheetFunctionがいけないのかと思って、この用にすると、アプリケーション定義と出ます。 MyRNo = Application.Match(h, KaMoku, 0) MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) 実行時エラー アプリケーション定義またはオブジェクトの定義エラー N = N + MyUNo Sheets("決算").Cells(3, 5).Value = N End If End Sub 素人の私には皆目見当がつきません、どうすれば良いのですか。 教えてください、どうかよろしくお願いします。
- 締切済み
- Visual Basic
- IF文の使い方を教えてください
もし A5001 に データがあるのなら処理を中止し、データが無ければ処理を継続する。内容のマクロを考えてますが、 A5001にデータがないなら処理を中止は下記の記述で良いかと思いますが、 逆にあったら処理を中止する記述はどうすればよいのですか？ Value が怪しいかと思うのですが・・・・ お願いします。 If Range("読み込み!A5001").Value = "" Then MsgBox "データがありません", vbOKOnly, "データ有無確認" Exit Sub End If ret = MsgBox("過去のシュミレーションデータを削除します。よろしいですか？", vbYesNo + vbQuestion, "データ削除実行確認") If ret = vbNo Then Exit Sub End If
- ベストアンサー
- オフィス系ソフト
- マクロ 記述が悪くエラーがかかります。
いつも回答ありがとうございます。 最後らへんの記述で実行時エラー【型が一致しません】がかかります。 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") ← ここでエラーがかかる。 ワークシート名に変数を使用しているせいだと思います。 解決する方法を御指導して頂けないでしょうか？宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date Dim Date2 As Date Dim SName As String Dim b1 As Variant Dim b2 As Variant Dim b3 As Variant Dim d1 As Variant Dim d2 As Variant Dim d3 As Variant With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column End With Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") Worksheets("集計用").Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3).Range("C2") End Sub
- ベストアンサー
- オフィス系ソフト
- OKを押してもキャンセルを押しても、反応しない
このコード、どこが間違ってるか教えてもらえますか？ Sub test() Dim ret As Variant ret = InputBox("タイトルを入力してください。") If TypeName(ret) = "Boolean" Then MsgBox "キャンセルが選択されました" End If End Sub これで、キャンセルボタンを押しても、メッセージボックスが表示されません。 間違えてる部分がわかりません。
- ベストアンサー
- オフィス系ソフト
お礼
よく判りました。 もともとNo2の回答で私のやりたいことはできたのですが、前に自分でfornextで行った時に時間がかかった記憶がありましたので書かさせて頂いたのですが、これで１０万件から該当約１００件を書き出すのに２．５秒くらいです。これは早いですこれぐらいで出来れば満足です。 これを使わせて貰いたいと思います。丁寧な説明と適確なご指摘ありがとうございました。