• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：マクロ　FIND　検索方向の変更）

マクロ FIND 検索方向の変更

DOUGLAS_の回答

  • ベストアンサー
  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.1

　VBE(Visual Basic Editor) のコードペインで、「Find」にカーソルを合わせ、[F1] ボタンを押下してください。 　[Find メソッド] のヘルプが開きますので、[Range オブジェクトの Find メソッド] をクリックしてください。 expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat) と書かれていますので、「SearchDirection:=xlPrevious」を付加してください。 Set c = .Columns("H").Find("増", , xlValues, 1, , xlPrevious) でよろしいですかね。 ＃「xlValues」の後の「1」は「xlWhole」の意味かと存じますが、引数が省略できますので、途中のカンマの位置等は是正してください。 　もしくは、名前付き引数を明示するのがよろしいでしょうか。。。 Set c = .Columns("H").Find(What:="増", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)

kero1192kero
質問者

お礼

返事が遅れてしまいすみませんでした。 FINDでF1を押したのですが、意味がさっぱり分からなくて、今回質問させて頂きました。事細かく書いて頂き、又、FINDの条件内容の数字の意味まで教えて頂きありがとうございました。

この回答がついた質問に戻る
回答 全件
こんばんは、失礼します。 解答はすでに出ていますが、コードを読んでい…
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • マクロ　別シートへコピー

    いつも回答して頂きありがとうございます。 Worksheets("一覧").Paste Range("C3")と記述したら、エラーもかからずうまく貼り付け出来るが、 Worksheets("一覧").Paste Range(Cells(d,3))と記述したらエラーが発生してしまします。どうしたら上手くいくでしょうか？ 下記に作成中のマクロを記載しておきます。 御指導の方よろしくお願いいたします。 Sub シートを繰り返し選択する(2)() Dim d As Integer Dim cVx As Integer d = 3 cVx = Range("IV7").End(xlToLeft).Column Worksheets(Worksheets("一覧").Cells(d, 2).Value).Range("C7:X7").Copy Worksheets("一覧").Paste Range(Cells(d, 3)) End Sub

  • エクセル 2010 マクロ 検索

    http://okwave.jp/qa/q8562170.html 上記質問に追加です。 ※1 'D,E,F,G,H,I,K を検索してD,E,F,G,H,I に検索対象があった時 E,F,G,H,Iのいずれかだったら左横列の上に向かって (EならD　、FならE ・・・という具合に) 何か入力されているセルのM列の191000####をmsgboxで表示させたいです。 (画 F11セル(A-1)が検索ヒットした場合E9セル(R-01)を辿り、 その行のM列のセル(191000####)をmsgboxで表示 ※2 但し、検索結果がD列のデータだった時、その行のM列が191000####だった場合 M列の191000####をmsgboxで表示させたいです。 (画 D25セル(Y-1)対象の時) ※3 また、検索結果がD列のデータだった時、その行のM列が191000####以外だった場合 (空白だったり191000####以外の場合) M列の一番上の191000####をmsgboxで 191000####&「これは例外です」と表示させたいです。 (画 D24セル (X-1)対象の時) 現在のコードは下記のとおりです。 Sheet1に Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Call 検索 Range("A1:A2").Clear Range("A1").Activate End Sub 標準モジュールに Sub 検索() 　Dim Ws1 As Worksheet, Ws2 As Worksheet 　Dim strKey As Variant 　Dim s As String 　Dim c As Range, bln As Boolean 　Dim rng1 As Range 　Dim cnt As Long 　 　Set Ws1 = Sheet1 　Set Ws2 = Sheet2 　 　Ws1.Select 　 　With Ws2 　　strKey = Application.Transpose(.Range("A1").Resize(2).Value) 　　strKey = Join(strKey, "") 　End With 　 　If Trim(strKey) = "" Then MsgBox "検索キーが空です", vbCritical: Exit Sub 　 　 　With Ws1 　　Set rng1 = .Range("K2", .Cells(Rows.Count, "K").End(xlUp)) 　　For Each c In rng1.Offset(, -10) 　　　 'D,E,F,G,H,I,Kを検索 　　　s = c.Offset(0, 3).Value & c.Offset(0, 4).Value & c.Offset(0, 5).Value & c.Offset(0, 6).Value & c.Offset(0, 7).Value & c.Offset(0, 8).Value & c.Offset(0, 10).Value & 　　　 　　　If StrComp(s, strKey, vbTextCompare) = 0 And c.Offset(0, 2).Value = "" Then 　　　　c.End(xlToRight).Activate c.Offset(0, 2).Value = Date 　　　　 　　　　c.Resize(1, 14).Interior.ColorIndex = 6 　　　　bln = True 　　　　Exit For 　　　End If 　　Next c 　　 　　If Not bln Then 　　　Ws2.Select 　　　MsgBox "リストに存在しません", vbExclamation, "NotFound" 　　Else '加える 　　　Call ReSearch(Ws1.Range("M2"), c.Row) 　　　'再設定 　　　Set rng1 = .Range("K6", .Cells(Rows.Count, "K").End(xlUp)) 　　　MsgBox "残り" & DoubleCountBlank(rng1.Offset(, -8), rng1) & "品目です。", vbInformation 　　End If 　End With 　Application.Goto Ws2.Range("A1"), True End Sub Sub ReSearch(Rng As Range, j As Long) '最初のセル, 終わりの行数 Dim i As Long Dim Ws As Worksheet With Rng.Parent For i = j To Rng.Row Step -1 If CStr(.Cells(i, Rng.Column).Value) Like "191000####" Then MsgBox "指図番号 " & vbCrLf & CStr(.Cells(i, Rng.Column).Value) & " の部品です" Exit For End If Next i End With End Sub Function DoubleCountBlank(rng1 As Range, rng2 As Range) '横並びのセルのブランクをカウントする (セル範囲1 , セル範囲2) 　Dim i As Long 　Dim cnt As Long 　For i = 1 To rng1.Rows.Count 　　If VarType(rng2.Cells(i, 1)) = vbDouble Then 　　　If rng1.Cells(i, 1).Value = "" And rng2.Cells(i, 1).Value <> 0 Then 　　　　cnt = cnt + 1 　　　End If 　　End If 　Next i 　DoubleCountBlank = cnt End Function 宜しくお願い致します。

  • マクロに関するエラー（オブジェクトが必要です。）

    マクロは始めてで、いろいろ調べながら作ってみたのですが、 Set検索値の行でオブジェクトが必要ですというエラーが出て、 先に進めなくなりました。 申し訳ないのですが、何方かエラーの対処法を教えていただけないでしょうか。 よろしくお願いします。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Sub test() Worksheets("2月分").Activate Dim 検索値 As Integer Set 検索値 = Worksheets("2月分").Cells(4, 18) Worksheets("テスト").Activate Dim B As Range Dim C As Range For Each B In Range("B13,B413") ' 第一条件 If B.Value >= 検索値 Then GoTo Continue End If ' 第二条件 If B.Offset(0, 1).Value < 検索値 Then ' Offset(0, 1) は B列の隣のC列の値を取得 GoTo Continue End If Dim aValue As String aValue = B.Offset(0, 2).Value Worksheets("2月分").Cells("D19").Value = aValue Continue: Next End Sub

  • マクロで質問します。

    初心者です。 下記のようなマクロの式があるのですが、条件を一つ増やしたいのですが、 イロイロ試してみたのですが、うまくゆきませんので教えてください！ Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("D14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(13, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub この中で　If Sh.Range("D14").Value > 0 Then　とありますが、 同じ条件で　I14も　０より大きいな時としたいのですが、　うまくゆきませんでした。 たぶん基本できな簡単な事と思いますが　分かりません。 If Sh.Range("D14").Value > 0 Then If Sh.Range("I14").Value > 0 Then　並べてみたり If Sh.Range("D14、I14").Value > 0 Then　こんなのや If Sh.Range("D14、I14").).Value > 0 Then　このような事も 他にも笑われるようなことも・・・・・　よろしくお願いします。

  • findで検索後、その下の行の値を別シートに参照させたい！

    いつも本当にお世話になっております。 タイトルのごとく、リストシートと表示シートがあり、表示シートに検索文字が表示してあります。 検索文字をリストシートから検索し、その下の行の値を表示シートに参照させたいのです。 わけがわからないながらも、作ってみました。 Dim i As Range Dim C As String Dim x As String C = Worksheets("表示シート").Range("e6") With Worksheets("リストシート") Set i = Columns("B").Find(C) End With Sheets("表示シート").Select Range("E6").Formula = "=リストシート!i.Offset(1, 1)" 　　 Range("E7").Formula = "=リストシート!i.Offset(1, 2)" end sub とすると、e6には、”リストシート!i.Offset(1, 1)”と表示されてしまいます。 行番号だけを認識し、Range("BX") や　Chells(x,1)みたいな形は無理でしょうか？ ご教示お願いいたします！

  • エクセルの簡単なマクロ機能を追加したいのです

    既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： 　Sheet2のC列に　0　 があれば 　Sheet1のB列に　愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub

  • Findステートメントで別なブックの検索

    Findステートメントで検索した内容のある行のA列にある値をキーワードとして別なブックのA列に検索をかけてヒットしたセルの内容を元のブックの指定したセルに移すという動作をさせたいので次ののように書いてみました。 Private Sub CommandButton2_Click() Dim Yline As Long Dim No As Variant Dim c As Range Dim sh As Worksheet Dim sh_no As Integer Dim findcell As Range Dim add As String Set sh = Worksheets("ブックAの1") No = TextBox1.Text sh_no = 1 'テキストボックスに値が入っていた場合 If No <> "" Then 'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない Set c = sh.Range("B:B").Find( _ What:=No, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '見つかった場合にのみ、値を入れる If Not c Is Nothing Then Yline = c.Row '見つかった行のA列の文字列でブックBに検索をかける add = sh.Cells(Yline, 1).Value Workbooks("B").Activate Set findcell = Workbooks("B").Worksheet(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '前Setステートメントからのループ検索開始 If findcell Is Nothing Then Do sh_no = sh_no + 1 If sh_no > ThisWorkbook.Worksheets.Count Then Exit Sub End If Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) Loop While findcell Is Nothing End If End If Workbooks("A").Activate With Worksheets("Aの2") 　　.Cells(21, 4).Value = sh.Cells(Yline, 14).Value .Cells(20, 4).Value = sh.Cells(Yline, 15).Value .Cells(36, 4).Value = findcell End With Unload Me Else MsgBox No & " は見つかりません。", 48 End If Set sh = Nothing End Sub するとwhat:=addとしてaddが見つかるまでシート番号を増やしていくループのところでエラーがでてキーワードが見つからないと出ます。恐らくブックBを検索してくれているとは思うのです。A列に空白があるためかと思い埋めてみましたが関係ないようです。 構文エラー的なものは無いと思いますが、宜しくお願いします。

  • マクロ　Value=Valueで複写できない

    いつも回答して頂きありがとうございます。 たぶん基本的な質問だと思うのですが、どうしたら上手くいくのか分かりません。御指導の程よろしくお願いします。以下の記述でエラーがかかります。 『コンパイルエラー：SubまたはFunctionが定義されていません』 Worksheets("一覧").Cells(d, 5).Value = Wokrsheets("編集用一覧").Cells(e, 5).Value 記述全体 Sub TEST() Dim d As Integer Dim e As Integer Worksheets("一覧").Activate d = 3 e = 6 Do While Worksheets("一覧").Cells(d, 2).Value <> "" Worksheets("一覧").Cells(d, 5).Value = Wokrsheets("編集用一覧").Cells(e, 5).Value d = d + 1 e = e + 4 Loop End Sub

  • 空白セルと０値を識別させたい。（VBA）

    すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0（変数D=0）の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub

  • マクロが思うように動きません

    エクセル2007です。 初心者です。 マクロが思うように動きません。 指定のセルが空白の場合、msgboxを表示して、処理を抜ける 空白でない場合は、処理をつつける。 と言う事をしたいです。 with～の後が問題だと思うのですが・・ Sub 受注履歴書き込み() Dim ws01 As Worksheet, ws02 As Worksheet Dim r As Long, c As Integer, tmp As Long Set ws01 = Worksheets("受注書") Set ws02 = Worksheets("受注履歴") ws01.Activate With ws01 If .Range("C2").Value = "" _ And .Range("M2").Value = "" _ And .Range("M11").Value = "" _ And Worksheets("粗利報告書").Range("D3").Value = "" Then MsgBox "受注Noが空白です。処理を中止します。" Exit Sub ws02.Cells(r, 1).Value = .Range("C2").Value ' 受注No ws02.Cells(r, 9).Value = .Range("A40").Value ' 備考 ws02.Activate End If End With End Sub 採点願えますでしょうか？ 宜しくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する