ExcelVBAについての検索機能の強化方法

前へ 次へ
このQ&Aのポイント
  • ExcelVBAを使用して、特定の条件に一致するデータを検索し、リストボックスに表示する方法について教えてください。
  • 現在、1文字以上一致で検索し、listboxに検索結果を表示させることができます。しかし、金額の範囲検索（例：1000～100000）を追加したいです。
  • もし、新しい方法やより良い方法があれば、教えていただきたいです。
回答を見る
  • ベストアンサー

ExcelVBAについて

以上～以下検索についてです。 現在、1文字以上一致で検索し、listboxに検索結果を表示させることができます コードは下記 Private Sub CommandButton1_Click() Dim lastRow As Long Dim myData, myData2(), myno Dim i As Long, j As Long, cn As Long With Workbooks("Master.xlsm").Worksheets("Sheet1") myData = .Range(.Cells(3, 2), .Cells(Rows.Count, 5).End(xlUp)).Value lastRow = .Cells(Rows.Count, 2).End(xlUp).Row End With ReDim myData2(1 To lastRow, 1 To 4) For i = LBound(myData) To UBound(myData) If myData(i, 2) Like "*" & TextBox2.Value & "*" And _ myData(i, 3) Like "*" & TextBox3.Value & "*" And _ myData(i, 4) Like "*" & TextBox4.Value & "*" _ Then cn = cn + 1 myData2(cn, 1) = myData(i, 1) myData2(cn, 2) = myData(i, 2) myData2(cn, 3) = myData(i, 3) myData2(cn, 4) = myData(i, 4) End If Next i If cn = 0 Then MsgBox "検索結果は見つかりませんでした・・・" Else End If With ListBox1 .ColumnCount = 4 .ColumnWidths = "20;40;20;60" End With End Sub そして今回教えていただきたいのが userfoamで 例えば,金額が1000～100000の間のものを検索し、 それに該当するものすべてをリストボックスに表示させることです。 このコードに以上～以下検索を追加するにはどうすればいいでしょうか？ 新しい方法、これよりいい方法があればお教えください。 よろしくお願いいたします。

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1606/2443)
回答No.1

> 金額が1000～100000の間のものを検索 検索方法はこちらを参考にして http://excel-ubara.com/excelvba4/EXCEL225.html 条件は以下のような感じでいかがですか。 1000 <= Range("A1") And 100000 >= Range("A1")

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • リストボックスから値取得時のエラー

    いつも助けていただきありがとうございます。 現在、ユーザーフォームを利用し一覧から検索し検索し、希望する事業所、氏名を、double clickで2ページ目に表示し、選択した様式に事業所名（A2）、氏名（B2)、作成日（A3)へを貼り付けたいとかんがえています。 一覧から事業所検索までは上手くいくのですが、事業所名、氏名、作成日を2ページ目に表示の際、型が一致しませんとでてエラーが出てしまう状態です。色々と検索、見直しなどしたのですがどうしても修正が聞かないので皆さんの知識をお借りしたいと思い質問させていただきます。 皆さんよろしくお願いします。 ※2ページ目表示でエラーがでて先に進めていないので、選択様式へ希望するCellへの書き出しについてはまだコードは作成していません。 Cellへの書き出しは問題なく出来ると思うのですが、希望する様式を選択する際のコードのアドバイスなども一緒に教えていただければ嬉しいです。 よろしくお願いします。 Private Sub 検索ボタン_Click() '検索を実行します。部分一致検索。 Dim lastrow As Long Dim myData, myData2() Dim i As Long, cn As Long '検索対象がない場合の警告 If 氏名検索テキストボックス.Text = "" Then MsgBox "検索対象を入力してください。" Exit Sub End If '検索するデータを配列　myData　に格納。 With Worksheets("名簿一覧") myData = .Range(.Cells(1, 4), .Cells(Rows.Count, 1).End(xlUp)).Value lastrow = .Cells(Rows.Count, 1).End(xlUp).Row End With '配列　myData の中で検索で一致したデータを配列　myData2　に格納。 ReDim myData2(1 To lastrow, 1 To 4) For i = LBound(myData) To UBound(myData) If myData(i, 2) Like "*" & 氏名検索テキストボックス.Value & "*" Then cn = cn + 1 myData2(cn, 1) = myData(i, 2) myData2(cn, 2) = myData(i, 3) myData2(cn, 3) = myData(i, 4) End If Next i '検索で一致したデータをリストボックスに表示。 With 検索表示リストボックス .ColumnCount = 4 .ColumnWidths = "70;70;70" .List = myData2 If .List(0, 1) = "" Then MsgBox "該当者がいません" End If End With End Sub 'ダブルクリックでセルを選択 Private Sub 検索表示リストボックス_DblClick(ByVal Cancel As MSForms.ReturnBoolean) With Worksheets("名簿一覧") .Range(.Cells(検索表示リストボックス.List(検索表示リストボックス.ListIndex, 0) + 1, 1), .Cells(検索表示リストボックス.List(検索表示リストボックス.ListIndex, 0) + 1, 4)).Select End With '選択したリストのデータ参照 Dim 行番号 As Integer 行番号 = ActiveCell.Row 作成日ラベル.Caption = Format(Date, "yyyymmdd") 氏名.Text = Cells(行番号, 2) 会社名.Text = Cells(行番号, 3) MultiPage1.Value = 1 End Sub

  • ExcelVBAでのユーザーフォームについて

    ご回答ありがとうございました。 これといった資料がなく(探し方が悪いのかもしれませんが)、少ない経験値で複雑なというか面倒な処理のマクロ(VBA)を組まされることになり、困っているところです。当初の話だと「勉強しながらでよい」ということだったのですが、いろいろと仕事が次々と舞い込んできて、そんな余裕もなくせっぱ詰まり少ない知識で必死にやっています。 先にご回答いただいた内容で是非アドバイスをいただきたいと思い、新たに質問させていただきました。 ユーザーフォームでマルチページを作っています。そこでもコンボボックスを使うのですがそこの記述方法をアドバイス下さい。やっぱり記述場所がおかしいのか、クリックするとリストの内容がコンボボックスをクリックした分だけ繰り返してしまうことがあります。 ////////////////////////////////////////////////////// Private Sub UserForm_Initialize() Dim sh As Worksheet Set sh = Worksheets("対象年") Dim i As Integer Dim lastRow As Integer lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row With ComboBox1 For i = 2 To lastRow If ComboBox1 = "" Then .AddItem sh.Cells(i, 1).Value End If Next i End With End Sub ////////////////////////////////////////////////////// Private Sub ComboBox1_DropButtonClick() Dim sh As Worksheet Set sh = Worksheets("対象年") Dim i As Integer Dim lastRow As Integer lastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row With ComboBox1 For i = 2 To lastRow If ComboBox1 = "" Then .AddItem sh.Cells(i, 1).Value End If Next i End With End Sub ////////////////////////////////////////////////////// とまぁ、結局コードは同じなのですが。 それと、結果をラベルに出させる場合には回答で記述いただいた ////////////////////////////////////////////////////// Private Sub ComboBox1_Change() 　　Dim vTgYear As Variant 　　vTgYear = ComboBox1.Value 　　Label1.Caption = vTgYear - 1 & "～" & vTgYear + 1 & "年" End Sub ////////////////////////////////////////////////////// で、よいでしょうか？ よろしくお願いいたします。

  • マクロ　入力する文字に色を付けたい

    Sub CountUp(ByVal mCol1 As String, mCol2 As String) Dim LastRow1 As Long Dim LastRow2 As Long Dim mRow As Long With Sheets("プレーヤー") LastRow1 = .Cells(Rows.Count, mCol1).End(xlUp).Row LastRow2 = .Cells(Rows.Count, mCol2).End(xlUp).Row If LastRow1 > LastRow2 Then mRow = LastRow1 Else mRow = LastRow2 End If If LastRow1 = 1 Then LastRow1 = 2 End If .Cells(mRow + 1, mCol1).Value = .Cells(LastRow1, mCol1) + 1 End With End Sub このコードに文字の色の指定をしたいです Selection.Font.ColorIndex = 3を入れたら赤色文字で入力できるかなと思ったのですがうまくいきませんでした（エラーにはならないのですが、色が付かなかったです）

  • excelVBAコードを教えていただけませんか

    excel2000です。 下記コードが簡単そうと思いつつ、いざやろうとすると自分では作ることができず投稿させていただきました。どうかご教授の程よろしくお願いいたします。 excel2000 VBAのコードを教えていただけませんか ・「差し込み表示.xls」から「実験データ」へ値を読みに行き、表示させようとしています。 一日だけの日付をする場合は、下記に記載しているようなコードで対応できるのですが、月を指定して、30(31)日分のデータを読みにいく場合、どういうコードに変更していいか分からず、投稿させていただきました。 ■やりたいこと ・年月を「差し込み表示」のＥ１セルに記載して、データ読み込みを押すと、したのＮＯ１～３１(日付をあらわしています）にそれぞれ対応する値を表示させたい。 ■現物ファイル 現物ファイルを、下記にＵＰさせて頂きました。差し支えなければ確認いただけると幸いです。よろしくお願いいたします。 ■アップローダー 投稿NO4662 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi ■一日で読み込むときのプロシ－ジャー Sub datatyuusyutu() Const sashikomiDisplay As String = "差し込み表示.xls" Const dataFile As String = "実験データ.xls" Dim i As Long Dim j As Long Dim k As Long Dim objectionrow As Long Dim lastRow As Long Dim targetDate As String Dim targetTime As String Dim data(1 To 43) As Double Dim dataFindFlag As Boolean Dim 対象フォルダ As String '検索する年月日を取得 targetDate = Range("E5").Value 対象フォルダ = ThisWorkbook.Path & "\" Workbooks.Open 対象フォルダ & dataFile lastRow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を得る '年月日で検索 For i = 2 To lastRow If Cells(i, 2) = targetDate Then Cells(i, 2).Select dataFindFlag = True For k = 1 To 43 data(k) = Val(Cells(i, k)) Next k Exit For End If Next i Windows(sashikomiDisplay).Activate With Workbooks(dataFile) If dataFindFlag = True Then Cells(1, 2) = data(1) Cells(12, 3) = data(4) Cells(14, 6) = data(5) MsgBox "実行しました" Else MsgBox "データがありません" End If End With Workbooks(dataFile).Close savechanges:=False End Sub

  • 下記のマクロをもっと早くするには？

    下記のマクロは、 A列にあるURLがSSL化（https）されているかを調べるものです。 このマクロを動かすと、大体３秒に１つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか？ また、エクセルの他の設定で、マクロを早くできたりしますか？ よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • ListBoxで表示されたデータの取得方法は

    お世話になります。 標準フォーム から以下のリストボックスを表示して、無事シートの一覧が表示されています。 Private Sub UserForm_Initialize() Dim lastRow As Long Dim myData Worksheets("Sheet1").Range("a1:C35").Value = "" With Worksheets(Sheet) myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 3).End(xlUp)).Value End With With ListBox1 .ColumnCount = 3 .ColumnWidths = "20;70;100" .List = myData End With End Sub このリストボックスにはボタンが二つありボタン1を押したときに標準フォームへ[hinban] という変数にリストボックスでフォーカスしているデータを取り込みたいのですが以下の方法でうまくいきません。 Private Sub CommandButton1_Click() Dim lastRow As Long Dim i As Integer hinban = ListBox1.Column(pvargColumn:=1) End Sub もう一つのボタンは何もせずにリストボックスを閉じたいのですがこれで問題ないですか。 Private Sub CommandButton2_Click() Unload Me End Sub プログラム初心者でインターネットから寄せ集めのプログラムです。 どなたかお力をお貸しください。

  • エクセル　ユーザーフォームでVLOOK

    ユーザーフォームのテキストボックスで、ご教示お願いいたします。 現在、以下のようなコードこちらで教えていただきセルに入力をしております。 テキストボックス5に値を入れ、 listのシートから該当する文字をテキストボックス6に表示させたいと思っております。 ■現在のコード '// Private Sub CommandButton1_Click() Dim LastRow As Long 'ここはキャメル形式やパスカル形式にします/大文字は定数です。 Dim i As Long '/テキストボックスに値があるか調べる For i = 1 To 7 Next i '/セルに書き込み With Worksheets("Sheet1") LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 1 To 7 .Cells(LastRow, i).Value = Me.Controls("TextBox" & i).Value Next End With '/TextBox1-7をクリア If MsgBox("テキストボックスを空にしてよろしいですか？", vbQuestion + vbYesNo) = vbYes Then For i = 1 To 7 Me.Controls("TextBox" & i).Value = "" Next i End If 'TextBox1にフォーカスを移動 Me.TextBox1.SetFocus End Sub ■付け足したいコード Private Sub textbox5_change() Dim temp, x temp = Me.textBox5.Value If IsNumeric(temp) Then temp = Val(temp) x = Application.VLookUp(temp, Sheets("list").Range("a1:b20"), 2, False) If Not IsError(x) Then Me.TextBox6.Value = x Else MsgBox Me.TextBox5.Value & " はリストにありません" End If End Sub 【質問内容】 付け足したいコードは上記の通りですが、どのように付け足せばいいのかが分からず、 困っております。 度々で申し訳ありませんが、テキストボックス5の値を見て、 テキストボックス6に表示させるやり方をご教示お願いいたします。

  • ExcelVBAで行と列の検索

    　　　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ １　　コード　あ　　い　 う　 え ２　　１０　　○　　　 ○ ３　　２０　　　　　○　　○ ４　 ３０　　　　　　　　　　○ 上記の表が5000件あります。Textbox1に入力し検索ボタンを押すと A列のコードを検索して一致する列の○のあるところの１行目の項目 をtextbox2に表示したいのですがうまく行きません。 よろしくお願い致します。 Private Sub CommandButton1_Click() '検索フォームボタン Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Sheets(1).Activate 最終行 = Range("A1").End(xlDown).Row サーチ行 = 0 For i = 2 To 最終行 If TextBox1.Value = Range("A" & i) Then If Range("B" & i, "N" & i) = "" Then TextBox2.Text = Range("B1", "N1") サーチ行 = i Exit For End If End If Next If サーチ行 = 0 Then MsgBox TextBox1.Value & "データはありません。", vbInformation, "無し" End If TextBox1.SetFocus End Sub エラーはでません。データはありませんとなります。 　

  • If Like Then条件式可変の場合の処理

    VBAにてSheet1の指定された番地にあるセルの値がSheet2のセル範囲にない場合はセルに色をつけると言うマクロを組んでいます。 Sub test() Dim i,z As Integer Dim WS As Worksheet Dim LastRow As Integer Dim Word1,Word2,Word3 As String Set WS = Worksheets("Sheet1") Word1 = WS.Cells(1,16).Value Word2 = WS.Cells(1,17).Value Word3 = WS.Cells(1,18).Value with Worksheets("Sheet2") LastRow = .Range("A" & Rows.Count).End(xlUp).Row For i = 3 To LastRow For z = 6 To 9 If .Cells(i,z).Value Like "*" & Word1 & "*" Or _ .Cells(i,z).Value Like "*" & Word2 & "*" Or _ .Cells(i,z).Value Like "*" & Word3 & "*" Then Else .Cells(i,z).Interior.ColorIndex = 6 End If Next Next End Sub 上記のマクロで変数Word1,2,3が1つだけの場合もあれば Word10まである場合も有り式を変更する必要が有ります。。 この場合、If Like 変数 Or の部分をフレキシブルに対応させる為にはどの様な式を書けば良いでしょうか(ToT)？ 申し訳ありませんがご教授下さい(ToT) 宜しくお願い致します。

  • エクセルのマクロで複数セル指定は？

    以前（7月22日　質問No.936181）の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル（例えばA1からA30の30個のセル）をいっぺんに書き込むようにしたいのですが可能でしょうか？ よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する