検索マクロ：検索名前テキストボックスに入力した名前を検索する方法
- 検索マクロを使用すると、検索名前テキストボックスに入力した名前を検索することができます。
- 検索する名前を入力せずに検索ボタンをクリックすると、検索する名前を入力してくださいというメッセージが表示されます。
- 存在しない名前を検索すると、該当なしというメッセージが表示されます。
- ベストアンサー
検索 マクロ
本を見ながら作ったのですが 検索してくれるのですが A列を検索してくれるのですが検索したいのは B列の4番目から下にあるだけ検索したいのですが どういじればいいのでしょうか？ Option Explicit Private lastRow As Long Private Index As Integer Private Sub UserForm_Activate() Dim i As Long lastRow = Worksheets("顧客情報").Cells(Rows.Count, 1).End(xlUp).Row + 1 If lastRow <= 3 Then MsgBox "データがありません。" Exit Sub End If For i = 3 To lastRow 名前リストボックス.AddItem Cells(i, 1) Next End Sub Private Sub 検索ボタン_Click() Dim searchName As String searchName = 検索名前テキストボックス.Text If searchName = "" Then MsgBox "検索する名前を入力してください。" Else Dim i As Long Dim no As Long For i = 0 To 名前リストボックス.ListCount - 1 If 名前リストボックス.List(i) = searchName Then no = i 名前リストボックス.ListIndex = no Exit For ElseIf i >= 名前リストボックス.ListCount - 1 Then MsgBox "該当なし。" Exit For End If Next Index = no + 3 Rows(Index).Select End If End Sub
- jikkenn
- お礼率58% (181/310)
- Excel（エクセル）
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こんにちは For i = 4 To lastRow 名前リストボックス.AddItem Cells(i, 2) Next ですか？
関連するQ&A
- マクロ 修正 （初心者です）
Option Explicit Private lastRow As Long Private Index As Integer Private Sub CommandButton1_Click() Unload Me End Sub Private Sub あいまいボタン_Click() Dim last As Long If 検索名前テキストボックス.Text = "" Then MsgBox "あいまい抽出する名前を入力してください。" Exit Sub End If last = Range("A500").End(xlUp).Row Range("A2:D" & last).AutoFilter Field:=2, Criteria1:="=*" & 検索名前テキストボックス.Text & "*" End Sub Private Sub UserForm_Activate() Dim i As Long lastRow = Worksheets("顧客情報").Cells(Rows.Count, 1).End(xlUp).Row + 1 If lastRow <= 3 Then Exit Sub End If For i = 4 To lastRow 名前リストボックス.AddItem Cells(i, 2) Next End Sub Private Sub 検索ボタン_Click() Dim searchName As String searchName = 検索名前テキストボックス.Text If searchName = "" Then MsgBox "検索する名前を入力してください。" Else Dim i As Long Dim no As Long For i = 0 To 名前リストボックス.ListCount - 1 If 名前リストボックス.List(i) = searchName Then no = i 名前リストボックス.ListIndex = no Exit For ElseIf i >= 名前リストボックス.ListCount - 1 Then MsgBox "該当なし。" Exit For End If Next Index = no + 3 Rows(Index).Select End If End Sub B列に名前を入力しています B3から検索してくれるマクロを作成しました（インターネット見ながら） 別の検索も作りたくてどこをいじればいいのかわからず書き込みました G3列（住所を検索）から下側を検索したいのですがどこをいじればいいでしょうか？
- ベストアンサー
- Visual Basic
- マクロ 入力する文字に色を付けたい
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を入れたら赤色文字で入力できるかなと思ったのですがうまくいきませんでした（エラーにはならないのですが、色が付かなかったです）
- ベストアンサー
- Excel（エクセル）
- 下記のマクロをもっと早くするには？
下記のマクロは、 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
- 締切済み
- Visual Basic
- リストボックスの内容を検索したいが...
エクセル2019を使っています。 添付画像のようにユーザーフォームにテキストボックスとリストボックスを作り、テキストボックスに入力した文字でリストボックスの内容を検索しようとコードを作成しました。 Private Sub TextBox1_Change() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").AutoFilter 1, "*" & TextBox1.Value & "*" If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then Set rng = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible) Else Me.ListBox1.Clear Exit Sub End If End With Me.ListBox1.Clear With Me.ListBox1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With End Sub Private Sub UserForm_Initialize() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rng = .Range("A2:A" & LastRow) End With With Me.ListBox1 .ColumnCount = 1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With ListBox1.ListIndex = 0 End Sub とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。
- ベストアンサー
- Excel（エクセル）
- リストボックスで選択した項目に該当するデーターをラベルに表示する
よろしくお願いします ユーザーフォームにリストボックスが2つ ラベルが1つ 配置しています。 リストボックス1で選択した項目に該当するリストを リストボックス2に表示する。 次に リストボックス2で選択した項目に該当するデーターを ワークシートのセル（E5：E300）から選んで ラベル1に表示する。 このようにしたいのですがエラーが出ます。 Dim LastRow As Long Dim DstRow As Long Const FstRow As Long = 5 Dim MctRow As Long － － － Private Sub UserForm_Initialize() With Me.ListBox1 .RowSource = Worksheets("入力").Range("A5:A300").Address(External:=True) End With End Sub － － － Private Sub ListBox1_Click() Dim j As Integer Dim RowCnt As Long With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row ListBox2.Clear For RowCnt = 5 To LastRow If ListBox1.List(ListBox1.ListIndex) = .Cells(RowCnt, 3).Value Then ListBox2.AddItem For j = 0 To 1 ListBox2.List(ListBox2.ListCount - 1, j) = .Cells(RowCnt,5 + j).Value Next j End If Next RowCnt End With End Sub － － － Private Sub ListBox2_Click() Dim SrcCode As Long SrcCode = ListBox2.List(ListBox2.ListIndex, 0) ↑ ↑ ↑ ここでエラーになります。 実行時エラー 型が一致しません と表示されます With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row MctRow = Application.WorksheetFunction.Match(SrcCode, .Range("E5:E" & LastRow), 0) + 5 Label1 = Format(.Cells(MctRow, 5)) End With 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 ////////////////////////////////////////////////////// で、よいでしょうか？ よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- 素数を求めるマクロを
走らすと暴走したようになり、素数＝１５１で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める() Dim i As Long Dim j As Long Dim m As Long Dim p As Long Dim flg As Boolean i = 1 j = 1 p = 2 Do flg = False For m = 2 To Int(Sqr(p)) If p Mod m = 0 Then flg = True Exit For End If Next If flg = False Then Cells(i, j) = p i = i + 1 If i > Rows.Count Then i = 1 j = j + 1 End If End If p = p + 1 Loop End Sub ======================
- 締切済み
- Excel（エクセル）
- エクセル 検索コピーマクロ
マクロで検索、抽出して別ファイルに保存したいのですが、 以下のようなマクロを教えてもらったのですが コピー先のセル位置を任意の位置に直したいのですが、 どうしてもわかりません どの部分をどう直せばよいのでしょうか？ Option Explicit Sub copyTodayData() Dim dateToday As String Dim tempDate As String Dim lastrow1 As Long Dim lastrow2 As Long Dim i As Long Dim fileA As String Dim anotherBook As String Dim anotherFilePath As String fileA = ThisWorkbook.Name anotherBook = "別のファイル.xls" anotherFilePath = "C:\Documents and Settings\日本太郎\デスクトップ\どこかのフォルダ" '問い合せダイアログの表示をOFFにします Application.DisplayAlerts = False 'ファイルを開く ChDir anotherFilePath Workbooks.Open Filename:=anotherFilePath & "\" & anotherBook '問い合せダイアログの表示をONに戻します Application.DisplayAlerts = True 'ウインドウの切替 Windows(fileA).Activate '今日の日付を取得 dateToday = Date 'データ最終行を取得 lastrow1 = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow1 If Cells(i, 1) = dateToday Then 'Range(Cells(i, 1), Cells(i, 4)).Copy 'コピー Windows(anotherBook).Activate 'ウインドウの切替 lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row '別ブックの最終行 Cells(lastrow2 + 1, 1).Select ActiveSheet.Paste Windows(fileA).Activate 'ウインドウの切替 End If Next i MsgBox "実行しました" End Sub たぶん、lastrow2 = Cells(Rows.Count, 1).End(xlUp).Row '別ブックの最終行 Cells(lastrow2 + 1, 1).Select ここらへんというのは、わかりますが、 どこをどう変えたらいいかわかりません
- 締切済み
- その他MS Office製品
- エクセル ユーザーフォームで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に表示させるやり方をご教示お願いいたします。
- 締切済み
- その他MS Office製品
- Excelのワークシートでのコンボボックスについて
Excelのワークシートでコンボボックスを設定する方法を教えてください。 「フォームコントロール」と「ActiveXコントロール」の違いがわかりません。 添付の画像の通りコンボボックスに西暦を入力(別シートに入力済みの値を表示するように設定)してあるのですが、ファイルを保存しているにも関わらず、再度ファイルを開くとコンボボックスの中のリストは空欄になってしまいます。 今は「ActiveXコントロール」のコンボボックスで設定しています。 コードは以下のように設定してみたのですが、設定内容や設定箇所が違うのでしょうか？ ////////////////////////////////////////////////////// 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 Worksheet_Activate() 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 ////////////////////////////////////////////////////// なんだかもう、訳がわからずぐちゃぐちゃです。 コンボボックスの中に値が入っていると、実行ボタンをクリックしたときは正常にやりたい結果を出すことが実現できます。 ファイルを閉じた後に再度開いてもコンボボックスの中に値があるようにするにはどうしたらよいのか、ド素人の私にご教授いただきたくお願いいたします。
- ベストアンサー
- Visual Basic
お礼
できました ありがとうございます