VBAのFindNextで次のセルを検索する方法
- Excel2010でVBAでマクロを作る際に、FindNextを使用して次のセルを検索しようとしていますが、一番上のセルだけを検索できてしまいます。どこか間違っている箇所があるのでしょうか。
- B列に「a」がある行のA列のセルに「b」を入力したいです。B列には複数の「a」が含まれています。
- 上記のコードは、B列に含まれる最初の「a」を見つけて、その行のA列に「b」を入力し、FindNextを使用して次の「a」を探し続ける処理です。しかし、何らかの理由で最初の「a」しか検索できないようです。何が間違っているのかお教えください。
- ベストアンサー
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 -----------------------------------------------------
- n_i_g
- お礼率52% (20/38)
- Excel（エクセル）
- 回答数2
- ありがとう数1
- みんなの回答 （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" Set a = .FindNext(a) Loop Until a.Address = firstAddressEnd If End With
その他の回答 (1)
- watabe007
- ベストアンサー率62% (476/760)
転記ミス Loop Until a.Address = firstAddress End If End With
関連するQ&A
- エクセルVBA条件セル検索時連続時処理中止と列複数
いつもお世話になっております。 Excel2013のVBAでまた質問があります。お願いいたします。 ある表のにある値が入力されていたら、その値をコピーして1行上の4列右の列に貼り付け、もとの行の値を削除するように色々参考にしながら作りました。 ある値を例えば、"AAA”と"BBB"だとして、下記コードでなんとか最初の段階が実現できました。 あと、やりたいのは、条件を検索する列の、"AAA"もしくは"BBB"の値が連続している場合は、メッセージを出して、処理を中止にしたいです。単体で連続でも２つの組み合わせでも、この２つのうちいずれかが入力されている行が続いていたら中止です。 あと、最初にWorksheets("Sheet1").UsedRange.Columns(5)列目を指定しているんですが、実際は、複数の列を指定したいです。コピーしたり消去したりのオフセットの位置関係は変わりません。 必要なら、名前を定義して、一括で指定するのも大丈夫です。 お手数をおかけしますが、ご教授よろしくお願いいたします。 Sub TEST() Dim c As Range Dim firstAddress As String ' ActiveSheet.UsedRange.Select With Worksheets("Sheet1").UsedRange.Columns(5) Set c = .Find(What:="AAA", _ LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then firstAddress = c.Address Do Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4) Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents Set c = .FindNext(c) If c Is Nothing Then Exit Do Loop Until c.Address = firstAddress End If '別条件でもう一度 Set c = .Find(What:="BBB", _ LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then firstAddress = c.Address Do Range(c.Address, Range(c.Address).Offset(0, 1)).Copy Range(c.Address).Offset(-1, 4) Range(Range(c.Address).Offset(0, -1), Range(c.Address).Offset(0, 6)).ClearContents Set c = .FindNext(c) If c Is Nothing Then Exit Do Loop Until c.Address = firstAddress End If End With End Sub
- ベストアンサー
- Excel（エクセル）
- VBAの繰りかえし処理について
workbook１(以下wb1）のB3に入力した県名を含む行を、 workbook２から取り出し、wb1のB7以降に表示させたいと思っています （ちなみに県名はwb2のC列に入っています） 同じ県名が含まれる行が多いので、それらを繰り返し処理で 全て書き出したいと思い、以下のマクロを作りました。 Sub macro3() Dim c Dim wb1 As Workbook Dim wb2 As Workbook Dim k As Integer Dim firstAddress As String Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("G:\zyouhousyori\inn100best_full.csv") Set c = cell.Find(What:=Range("B3").Value) With wb2.Worksheets(1).Range("A1:A100") If Not c Is Nothing Then firstAddress = c.Address Do Set c = cell.FindNext(c) For k = 0 To 10 .Range("C100").End(xlUp).Offset(1).Copy _ wb1.Worksheets("sheet1").Cells(7 + k, 2) Exit For ★Loop While Not c Is Nothing And _ c.Address <> firstAddress End If End With Application.ScreenUpdating = True wb2.Close False End Sub しかし、実行すると★マークのついた所でエラーになってしまいます （対応するDoがありません、と出ます） VBA初心者なので、どこがどう違うのかいまいちわかりません； アドバイスお願いします。
- 締切済み
- その他([技術者向] コンピューター)
- エクセル 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からの表示になるようにスクロールするにはどのようにしたらいいでしょうか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 重複チェック
マクロ初心者です。（エクセル２００３使用） Ａ列の管理番号が重複していたら、Ｃ列に☆をつけるようなマクロを作りたいのですが、うまくできません。 すみませんが、どなたか教えてください。 （Sheet1) A B C アカ154-7 アカ226-9 ☆ アカ446-0 アカ675-4 ☆ アカ669-8 アカ226-9 ☆ アカ118-5 アカ675-4 ☆ アカ226-9 ☆ （マクロ） Sub 重複() Dim 管理番号 As Variant Dim motoSht As Worksheets Dim セル範囲 As Range With Sheets("Sheet1") 管理番号 = Sheet2.Range("A2").Value Set セル範囲 = Range("A2:B65536").CurrentRegion.Find(管理番号, , LookAt:=xlWhole) If 同じ管理番号があったら Then Range("A").CurrentRegion.Offset(2) = ☆ ElseIf Not セル範囲 Is Nothing Then MsgBox "管理番号は、重複していません" End If End With End Sub ご回答よろしくお願いいたします。
- 締切済み
- Visual Basic
- エクセルＶＢＡの連続検索
エクセルＶＢＡで、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 手直しをお願いしますＴＴ
- 締切済み
- Visual Basic
- ２つのものが一致時に転記するマクロ
いつもお世話になります。 ここのサイトで ２つのブックでIDが一致したら 横にある文字を転記するというマクロがあるのですが 同じIDが続いても転記先のエクセルに全て転記したいと質問させて頂き そのマクロを使わせて頂いたのですが ＩＤと時間を一致したものを転記させなければいけなくなりました Ａ列の時間とＢ列のＩＤを一致したときに 大元に転記させるのは、変数で2つの項目を設定して 確認させればいいのかと思っていましたが上手くいきません 更に、データ量が多いので マクロを動かすたびに応答なしになるので コードをfindから別なコードを変えたほうがよろしいのでしょうか？ 下記にマクロのコードと構成と画像を記述させて頂きます お手数ですがご教授して頂けないでしょうか？ 恐縮ですがよろしくお願いいたします。 Sub 転記改造() Dim w0 As Worksheet, w1 As Worksheet Dim h As Range, Target As Range Dim i As Range, Target1 As Range Dim FirstAddress As String Set w0 = Workbooks("IDデータ.xls").Worksheets(1) Set w1 = Workbooks("ID管理票.xls").Worksheets(1) For Each h In w0.Range("A2:A" & w0.Range("A65536").End(xlUp).Row) For Each i In w0.Range("B2:B" & w0.Range("A65536").End(xlUp).Row) If h.Offset(, 1).Value = "確認" Then Set Target = w1.Range("D11:D60000").Find(what:=h.Value, LookIn:=xlValues, lookat:=xlWhole) If Not Target Is Nothing Then FirstAddress = Target.Address Do If Target.Offset(, -1).Value = "" Then Target.Offset(, -1) = "確認" Exit Do Else Set Target = w1.Range("D11:D60000").FindNext(Target) End If Loop While FirstAddress <> Target.Address End If End If Next next End Sub
- ベストアンサー
- Excel（エクセル）
- VBA教えて下さい
for nextの使い方がわかりません 変数を使用し条件に当てはまる数値だけ 処理するといった内容です 考えたコード sub test() dim a as variant dim b as variant dim i as variant with workbooks("book1").activesheet set a =.range("A5") set b =.range("B5") end with with workbooks("book2").activesheet for i = 80 to 110 if a = cells(i,1) then b.value = cells(i,2) end if next i end sub このコードにてやりたい事は まず、book1の今開いてるシートを参照し A5セル、B5セルをセットし (例えばA5は2と入力している B5セルは10000と入力している) 次に、book2の今開いてるシートを参照し もし、1行目の80～110どれかのセルの数字が 変数aと同じ値ならば (A行80～110行のセルの数字2があれば 例えば85列) 変数bの数字を2行目の80～110に条件に当てはまるセルに移す (B行85列にB5セルの値10000を移す) ()の部分は例えで書いてます 読みにくかったら無視でお願いしますm(__)m 指定の仕方など間違ってると思うので コードを書いてくれると助かります 回答お願いしますm(__)m
- ベストアンサー
- Visual Basic
- シート上に
シート上に Ａ学科 相川 秋山・・・鈴木・・・ Ｂ学科 伊藤 ・・・鈴木 ・ ・ ・ と書いてあります。 Sub Find_01() Dim c As Object Dim myKey As String, fAddress As String myKey = "鈴木" With Worksheets(1).Range("a1:a30") Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _ SearchOrder:=xlByColumns, MatchByte:=False) If Not c Is Nothing Then fAddress = c.Address Do c.Interior.ColorIndex = 3 Set c = .FindNexｔ(c) If c.Address = fAddress Then Exit Do Loop End If End With End Sub このプログラムで「鈴木」と書いてあるセルに色がつくのですが 「鈴木」という部分にはマークをせず、学科の部分をマーク するにはどうすればよいのでしょうか？
- ベストアンサー
- Visual Basic
- エクセルＶＢＡのＦＩＮＤの質問です。
エクセルＶＢＡのＦＩＮＤの質問です。 シート１ A B C D 1 コード１ コード２ コード３ 名 称 2 4 1 1 3 4 2 2 4 4 3 1 シート２ A B 1 コード１ 名 称 2 1 名称１ 3 2 名称２ やりたいことは、シート１のＤ列に、シート１のコード３をもとにシート２から名称を取得したいのです。 下記に記したプログラムだと最初のＦＩＮＤＮＥＸＴは動くのですが、 2回目でエラーになってしまい、次を読んでくれません。 どなたか、ご教授頂けますでしょうか。 シート１の検索条件はコード１の"4"です。 シート１のコード１は重複キーで、一レコードずつ読んで行き、各レコード毎にシート２を読みたい のです。 Dim シート1 As Worksheet Dim シート2 As Worksheet Dim obj As Object Dim Lin As Integer Dim mykey As Integer Dim obj1 As Object Dim Lin1 As Integer Dim mykey1 As Integer Dim st_Lin As Integer Set シート1 = ThisWorkbook.Worksheets("シート１") Lin = シート1.Cells(シート1.Rows.Count, 1).End(xlUp).Row mykey = "4" Set obj = シート1.Range("A1", "A" & Lin).Cells.Find(What:=mykey, _ LookIn:=xlValues, _ lookat:=xlWhole, _ SearchOrder:=xlByColumns) If obj Is Nothing Then MsgBox ("異常です") Exit Sub Else st_Lin = obj.Row Do Until obj.Row <> st_Lin Set obj = シート1.Range("A1", "A" & Lin).FindNext(obj) If obj Is Nothing Then Exit Do Else Set シート2 = ThisWorkbook.Worksheets("シート２") With シート2 Lin1 = .Cells(シート2.Rows.Count, 1).End(xlUp).Row mykey1 = シート1.Cells(obj.Row, 3).Value Set obj1 = .Range("A1", "A" & Lin1).Cells.Find (What:=mykey1,LookIn:=xlValues,lookat:=xlWhole,SearchOrder:=xlByColumns) If obj1 Is Nothing Then MsgBox ("名称取得できませんでした") Exit Sub Else シート1.Cells(obj.Row, 4).Value = .Cells(obj1.Row, 2).Value End If End With End If Loop End If
- ベストアンサー
- その他（プログラミング・開発）
- VBA 請求書の自動印刷について
VBAで請求書の連続印刷について質問です。 Sheet("基本情報")のA列に請求書No. B列に請求日が記載されております。 ComboBoxで入力されている請求日を選択することで、該当の全データを請求書フォーマットに転記して、全て印刷するマクロを組んでみたのですがうまくいきません。 流れとしては以下の通りです。 １、ComboBoxで請求日を選択(20日) ２、Sheet("基本情報")から、請求日が20日に該当するデータをSheet("請求書")に転記 ３、Sheet("基本情報")の請求日が20日でA列の請求書Noと一致する、Sheet("詳細")の該当データを Sheet("請求書")に転記 ４、印刷したら、入力データをクリアしてから、次の該当データを転記 Loop と、したいのですが、１～入力データのクリアまでは問題なく作動するのですが、次の該当データに移行しません。 MsgBoxでAddressの表示を行ったところ、たまに関係ないセルのアドレスの表示も確認でき、全くわからなくなってしまいました。 何卒、御教授の程お願い致します。 また、作成中のため、記述の整理は出来ておりませんが、併せて御教示頂ければ幸いです。 Private Sub CommandButton1_Click() Dim Ws As Worksheet, ws2 As Worksheet, pSht As Worksheet Dim StrFind As String, Res As String, _ firstAddress As String, buf As String Dim rg As Range, rg1 As Range Dim 選択行 As Integer, 選択行1 As Integer Dim i As Long, A As Long, MinRow As Long buf = Year(Date) & "/" & Month(Date) & "/" StrFind = ComboBox1.Value Set Ws = Worksheets("請求書") Set ws2 = Worksheets("詳細") Set pSht = Worksheets("基本情報") If StrFind = "" Then MsgBox "送付日を指定してください。" Exit Sub End If With pSht Set rg = .Columns(2).Find(What:=StrFind, LookAt:=xlWhole) 選択行 = rg.Row Set rg1 = ws2.Columns(1).Find(What:=.Cells(選択行, 1)) 選択行1 = rg1.Row If Not rg Is Nothing Then firstAddress = rg.Address Do DoEvents '~~~~~ここに転記の構文 およそ200行前後~~~~~ Set rg = .Columns(2).FindNext(rg) If rg Is Nothing Then Exit Do Loop Until rg.Address = firstAddress Unload Me End If End With End Sub
- 締切済み
- Visual Basic
お礼
ありがとうございます！ オブジェクト変数はSetで代入しないとだめなんですね。助かりました。