- 締切済み
エクセルＶＢＡの連続検索
エクセルＶＢＡで、textbox内に入力した参加者の名前を検索しチェックを入れる作業を行いたいです（集会の受付名簿用）。findnextを使っても無限にループするか、同姓の最初の一人しか検索できずに困っています。 Dim 検索セル As Range Dim 最初のセル As String Dim 次の候補 As Range 検索対象文字 = Range("h2").Value Set 検索セル = Range("a5:B100").Find(検索対象文字) If Not 検索セル Is Nothing Then 最初のセル = 検索セル.address Do 検索セル.Select Set 次の候補 = Range("a5:b100").FindNext(after:=検索セル) Loop Until 次の候補．address ＝ 最初のセル End If 手直しをお願いしますＴＴ
- batovic
- お礼率33% (1/3)
- Visual Basic
- 回答数3
- ありがとう数1
- みんなの回答 （3）
- 専門家の回答
みんなの回答
- n-jun
- ベストアンサー率33% (959/2873)
ANo.1です。 >受付ですので、出欠の入力と参加者の席を確認して案内したいと思っています。 であれば、修正したコードで問題はありませんか？ 或いは追記があれば、提示願います。
- n-jun
- ベストアンサー率33% (959/2873)
ANo.1です。 >同姓の最初の一人しか検索できずに困っています。 多分１周まわって戻ってきているだけだと思います。 ”検索してどうしたいのか”が不明なのです。 そのためMsgBoxで一回ずつ止めてみました。
- n-jun
- ベストアンサー率33% (959/2873)
Dim 検索セル As Range Dim 最初のセル As String Dim 検索対象文字 As String 検索対象文字 = Range("h2").Value Set 検索セル = Range("a5:B100").Find(検索対象文字) If Not 検索セル Is Nothing Then 最初のセル = 検索セル.Address Do 検索セル.Select Set 検索セル = Range("a5:b100").FindNext(検索セル) MsgBox "次を選択" Loop Until 検索セル.Address = 最初のセル End If こんな感じでしょうか？
お礼
今、動作チェックを完了しました。やりたかったことができています。大変感謝しておりますＴＴ
関連するQ&A
- エクセル VBA 検索 スクロール
お世話になります。 A列に製品名、B列に場所と詳細を表した表です。 E1に製品名を入れて検索ボタンを押すと右隣のセルの値がE1に表示され検索件数がMsgBoxに表示されるものをこのページで聞いたりしながら作りました。 'Dim 対象セル As Range 'Dim 最初のセル番地 As String 'Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub Set 対象セル = Range("A2:A1287").Find(What:=Range("E1").Value, After:=Range("A1287"), lookAt:=xlWhole) If 対象セル Is Nothing Then Exit Sub 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Range("A2:A1287").FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 Range("E3").Value = 対象セル.Offset(, 1).Value MsgBox "検索件数は" & 検索件数 & " 件です" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub 今回質問したいのは検索したセルを含む行（製品名によって複数あります）を自動で一番上、A5でウィンドウの固定をしてあるのでA6からの表示になるようにスクロールするにはどのようにしたらいいでしょうか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 検索
お世話になります。 範囲がA2からK221までの表があります。 検索して検索されたセルの左のセルを表示するマクロを組みたいのですが、検索する文字（数値）はE1に、検索結果はK1に表示するようにするにはどのようにしたらいいでしょうか？ Sub FIND_DATA1() ' FIND_DATA1 Macro ' マクロ記録日 : 2006/9/1 ユーザー名 : ' Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole).Activate End Sub Sub Data_Find3() Dim 対象セル As Range Dim 最初のセル番地 As String Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub End If Set 対象セル = Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole) 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Cells.FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 MsgBox "検索件数は" & 検索件数 - 1 & " 件です" End Sub 本を見たり調べたりでここまでできたんですがこれだと検索件数、検索結果が色付きになるだけで使い勝手がいまいちです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAのFindNextの使い方
Excel2010でVBAでマクロを作ろうとしていますが、 FindNextで次検索をしても、一番上のセルだけしか検索できません。 どこかおかしな箇所はあるでしょうか… B列に「a」がある行のA列のセルに「b」を入力したいです。 B列には「a」があるセルは2セル以上あります。 ----------------------------------------------------- Dim a As Range Dim firstAddress As String With ActiveSheet.Range("B:B") Set a = .find("a", LookAt:=xlWhole) if Not a Is Nothing Then firstAddress = a.Address do Cells(a.Row, 1).Value = "b" a = .FindNext(a) Loop Until a.Address = firstAddrss End If End With -----------------------------------------------------
- ベストアンサー
- Excel（エクセル）
- VBAを使って検索をしたい
VBAを使って検索をしたい EXCEL２００７を使っております。 フォームを立ち上げて日付を入れるとシートの検索を行い、リスト内にその日付のA～Ｇまでのセルの内容が表示され、それらを別シートに貼り付けるといったことをしたいのですが、複数のセルの情報をリスト内に表示をするのが、よくわからず教えていただきたく思います。 フォーム内のテキストボックスに検索する日付を入れると 画像でいうところのA列を検索し、その日付内のA～Gをリストに表示して、ボタンを押すと貼り付けるといった、動きにしたいのですが、お願いします。 現状検索ＢＯＸに以下の記述をしてます これでは、Ａ列のものだけが出てきます。お助けください。 ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ Private Sub TextBox1_Change() Dim r As Range, FirstCell As Range, rng As Range Dim vnt As Variant Dim prow As Long Dim s As Worksheet Dim cnt As Long Set s = Sheets("sheet2") Set rng = Intersect(s.Range("a:a"), s.UsedRange) '検索キー Set r = rng.Find(What:=TextBox1.Text) If r Is Nothing Then MsgBox "見つかりませんよ" GoTo Exit_sub End If Set FirstCell = r ReDim vnt(0) vnt(0) = s.Cells(r.Row, 1).Resize(1, 5).Value '検索位置 prow = r.Row cnt = 1 Do Set r = rng.FindNext(r) If Not r Is Nothing And (r.Address <> FirstCell.Address) _ And (FirstCell.Row <> r.Row) And (prow <> r.Row) Then ReDim Preserve vnt(UBound(vnt) + 1) vnt(UBound(vnt)) = s.Cells(r.Row, 1).Resize(1, 5).Value '検索位置 prow = r.Row cnt = cnt + 1 End If Loop While r.Address <> FirstCell.Address ' If cnt = 1 Then vnt = s.Cells(FirstCell.Row, 1).Resize(1, 5).Value '検索位置 If cnt > 1 Then vnt = Application.Transpose(Application.Transpose(vnt)) ListBox1.List = vnt ' Set FirstCell = Nothing Erase vnt Exit_sub: If cnt = 0 Then ListBox1.Clear Set r = Nothing Set rng = Nothing Set s = Nothing End Sub
- ベストアンサー
- その他MS Office製品
- EXCEL VBA 文字列検索とコピー
以前にも同じ質問をさせて頂いたのですが、どうも上手くいかないので今一度お願い致します！ 名簿を作成していて、現在下記のようなシートになっています。 [ Sheet1 ] Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ 日付 ○ ○ ○ ○ 名前 電話 メール このＦ列の名前を検索して、検索文字に該当する全てのセルの行ごと（出きればA1:H2の範囲）コピーして、Sheet2に貼り付けたいです。 現在のコードは、以下のようになってます。 宜しくお願いします！！ Sub 検索1() Dim myFind As Variant Dim myfRow As Long, c As Range Dim CopySh As Worksheet Dim i As Long Dim num As Integer Set CopySh = Worksheets("Sheet2") 'コピー先のセルの最初の行 i = 1 '================================== myFind = Application.InputBox("検索文字をカナで入力してください", Type:=2) If VarType(myFind) = vbBoolean Or myFind = "" Then Exit Sub With Worksheets("Sheet1").Cells(4.4) Set c = .Find(myFind, , xlValues, xlWhole) If Not c Is Nothing Then myfRow = c.Row Do c.Copy CopySh.Cells(i, 1) 'コピー Set c = .FindNext(c) i = i + 1 Loop Until c Is Nothing Or myfRow = c.Row End If End With Beep '終了の合図
- ベストアンサー
- オフィス系ソフト
- エクセルVBA FindNextについて
エクセル2002使用です。 VBAのFindNextメソッドについて教えていただけますでようか？不定期の行ごとに存在する○から△までの表を抽出するために次のようなコードをつくりました。 A B C D １ ○ × × ２ × × × ３ △ × × ４ ５ ○ × × ６ × × × ７ △ × × Sub 表の抜き出し（） Dim myr1 as range Dim myr2 as range Dim firstmyr1 as String Set myr1 = Columns("A").Find(What:="○") firstmyr1 =myr1.adress Set myr2 = Columns("A").Find(What:="△") Do 処理・・・・ Set myr1 = Columns("A").FindNext(after:=myr1) Set myr2 = Columns("A").FindNext(after:=myr2) Loop until myr1.adress = firstmyr1 End Sub 上記のようなコードで、処理の後のSetステートメントでFindNextを使うと、A5の○とA7の△を見つけてほしいのに、1回目の処理・・・の後の読み込みでウオッチで見るとmyr1値が△になってしまって2回目の読み込みにいけません。Setステートメントが2つ以上あるときのFindNextメソッドの使い方で何か注意点があるのでしょうか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- excel vbaについてです
VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない？といったアドバイスもお願いします(-人-)
- ベストアンサー
- その他MS Office製品
- エクセルVBAであいまい検索フォームを作りたいです。
エクセルVBAであいまい検索フォームを作りたいです。 （Ctrl+Fではなく） 商品群A・商品群B・商品群C・・・・と分けられたシートの すべてのA列に、商品名が入っています。 テキストボックスと【検索】ボタンと【次を検索】ボタンのみの 単純な検索用ユーザーフォームから 商品名をシートをまたいで検索し、 Ctrl+Fと同じように該当セルに移動、 次を検索で次の商品へ移動、 すべてのシートに該当商品が無ければ メッセージボックス「該当する商品はありません」 なんとなく出来そうな気がしてチャレンジしましたが、 基本がなっていないため行き詰りました。 （自動マクロを少しいじる程度なので・・・） とんでもなく支離滅裂ですが、チャレンジしたゴミコードを晒します。 順番がおかしいのは判るのですが、どうすればいいのか。。。 どなたか、このコードを正し添削して頂けませんか。 （あ、このコードにこだわっているわけではないので、 もっと他に適した方法があるのなら、それを教えてください） よろしくお願い致します。 ちなみに、作成はexcel2007ですが、2000・2003に配布します。 Dim s As Variant Dim c As Range Dim f As Range For Each s In Worksheets 'ブック内各シートに繰り返し With s s.Select 'シートを選択 Set f = Columns("B").Cells 'B列を変数にセット Set c = f.Find(What:=Trim(strData), LookIn:=xlValues, MatchByte:=False, LookAt:=xlPart) 'FINDでstrData(userformからの入力した文字列)をあいまい検索としてセット If Not c Is Nothing Then Application.Goto c, True '見つかった時は該当セルに飛ぶ Else End If End With Next End Sub
- 締切済み
- オフィス系ソフト
- Excel VBA ループについて
Excel VBA勉強中の者です。 シート名「一覧」のA列に入力されている「1」を検索し、メッセージボックスに表示させています。 現在、「1」はA3、A5、A7に入力されています。 下記のコードだとA3、A5、A7がメッセージボックスで表示された後、もう一度A3が表示されてしまいます。 A7が表示された時点で終わりにしたいのですが、どこを修正すればいいのでしょうか？ Sub test() Dim xRange As Range Dim fPlace As String Dim i As Integer Dim xMoji As String xMoji = 1 Set xRange = Worksheets("一覧").Range("A1:A100").Find(What:=xMoji) If Not xRange Is Nothing Then fPlace = xRange.Address Msgbox xRange.Address Do Set xRange = Worksheets("一覧").Range("A1:A100").FindNext(After:=xRange) If Not xRange Is Nothing Then Msgbox xRange.Address End If Loop Until fPlace = xRange.Address End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel vba 一度で全角・半角の文字を検索
Excel vbaの初心者ですが、他のサイトを参考にして 以下のプログラムを作成しました。 指定された文字をシートから削除する物です。 「FindDelete」の中で、一度で全角・半角の文字を検索する方法があれば 教えてください。よろしくお願いします。 Sub FindDelete(ss As String) Dim FoundCell As Range Dim FirstCell As Range Dim Target As Range Dim c As Range Dim findArea As Range Set findArea = Intersect(Columns("E:F"), ActiveSheet.UsedRange) Set FoundCell = findArea.Find(What:=ss, LookAt:=xlPart) If FoundCell Is Nothing Then MsgBox ss & "は見つかりません" Exit Sub Else Set FirstCell = FoundCell Set Target = FoundCell End If Do Set FoundCell = findArea.FindNext(FoundCell) If FoundCell.Address = FirstCell.Address Then Exit Do Else Set Target = Union(Target, FoundCell) End If Loop Target.Select If MsgBox(ss & "：" & vbCrLf & Target.Count & "件見つかりました", vbYesNo, "削除しますか？") = vbYes Then For Each c In Target c = Replace(c, ss, "") Next c End If End Sub Sub tFindDelete() Dim ss As String ss = "カブシキガイシャ" ss = StrConv(ss, vbNarrow) FindDelete (ss) ss = StrConv(ss, vbWide) FindDelete (ss) ss = "ユウゲンガイシャ" ss = StrConv(ss, vbNarrow) FindDelete (ss) ss = StrConv(ss, vbWide) FindDelete (ss) End Sub
- 締切済み
- その他（プログラミング・開発）
補足
受付ですので、出欠の入力と参加者の席を確認して案内したいと思っています。