[[20220610114309]] 『検索に該当する2番目のセル行の取得 (VBA)』(no_name) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『検索に該当する2番目のセル行の取得 (VBA)』(no_name)

下記の表について

A列を Match 関数で「No3」を行検索した場合(検索範囲A1~A5),
出力結果は「3」が返ってくるのですが,4行目の「No3」を検索するには,
VBAではどのような方法があるのかご教授お願いします.

試した方法としては Match 関数を2回使い1回目の検索結果(行値)をもとに
2回目の Match 関数の検索範囲を変更することで取得しようしましたが,
検索範囲が変更されず「3」が返ってきました.

Debug.Print 等で検索範囲の値が変更されていることは確認しています.

      |[A]  |[B]|[C]|[D]|[E]
 [1]  | No1 |  |   |  |   
 [2]  | No2 |  |   |   |   
 [3]  | No3 |  |   |   |   
 [4]  | No3 |  |   |   |   
 [5]  | No4 |  |   |   |   
 ・
 ・
 ・

以下はやりたいことの詳細です(質問経緯).

現在品番に対応する注文番号を入力するために,品番を Match 関数で検索し(行方向),検索値の行 + 注文番号列 のセルに注文番号を入力する処理を VBA で作成しました.

しかし,同じ品番で注文番号の異なる場合があり,従来のままでは注文番号が上書きされてしまいます.そのため,同じ品番が検索された場合注文番号が既に入力されているか判定し,入力されている場合は入力されているセルより後の行から品番を検索することで対策したいと考えました.

< 使用 Excel:Excel2019、使用 OS:Windows10 >


Findメソッドを使う方法もあると思います。
ヘルプに例文が載っていますので、参考にされたらいかがでしょうか。
(γ) 2022/06/10(金) 12:23

モロかぶりしましたがそのまま。

Findメソッドを使って、逆順(下から上へ)で検索するのはどうでしょうか?
そうすれば、常に最後の【セル】が得られると思います。

(もこな2) 2022/06/10(金) 12:26


Find 検討してみます.

しかし,非表示セルの検索ができない点やループ処理すると速度が落ちる点から,
出来れば Match 関数かFind 以外の方法があればご教授お願い致します.
(no_name) 2022/06/10(金) 13:05


 >Match 関数を2回使い1回目の検索結果(行値)をもとに2回目の Match 関数の検索範囲を変更する
 基本的な考え方はいいと思います。
 実際のコードを書き込んだらアドバイスがもらえると思います。
 速度はどうやったって落ちますが、気にするほどですか?

 Function LastMatch(ByVal searchKey As Variant, ByVal targetRange As Range) As Variant
   Dim n As Long, i As Long
   Set targetRange = targetRange.Columns(1)
   n = WorksheetFunction.CountIf(targetRange, searchKey)
   On Error Resume Next
      i = WorksheetFunction.Match(searchKey, targetRange, 0)
   On Error GoTo 0
   Select Case n
      Case 0
         LastMatch = CVErr(xlErrNA)
      Case 1
         LastMatch = i
      Case Else
         Set targetRange = targetRange.Resize(targetRange.Cells.Count - i).Offset(i)
         LastMatch = i + LastMatch(searchKey, targetRange)
   End Select
 End Function
(´・ω・`) 2022/06/10(金) 13:09

´・ω・`さん

コードありがとうございます.

確かに速度の点はテスト環境では特に問題ありません.
しかし,似たような状況でFind を使ったプログラムを作成した際に処理速度がネックになった経験があるので極力 Find を使わないようにしていました.

後は非表示セルを拾えないのがちょっと問題かなと思っています.
基本的には私自身が使う物なのでそういうものと思って運用すればいいですが,
将来的に別の人渡す可能性があるので,できるだけ前処理なくボタン1つで作業終わるようにしたいと考えています.

下記に現在作っているコード(変数定義やシート指定等は省略)を記すのでアドバイスあればお願い致します.ところどころおかしい点があると思いますがコードのイメージだと思ってください.

Sub test(品目番号, 注文番号)

    On Error Resume Next

            saerchRow = WorksheetFunction.Match(品目番号, Range(Cells(1, 品目番号列), _
                                                                Cells(Cells(Rows.Count, 品目番号列).End(xlUp).Row, 品目番号列)), 0)              
    On Error GoTo 0

    If saerchRow = 0 Then

       Debug.Print "「" & 品目番号 & "」はありませんでした。" 

       Exit Sub

    End If

    If Cells(saerchRow, 注文番号列).Value <> "" Then

            On Error Resume Next

                    saerchRow = WorksheetFunction.Match(品目番号,Range(Cells(saerchRow + 1, 品目番号列), _                                                                    Cells(Cells(Rows.Count, 品目番号列).End(xlUp).Row, 品目番号列)), 0)

            On Error GoTo 0

            If saerchRow = 0 Then

                    Debug.Print "「" & 品目番号 & "」はありませんでした。" 

                    Exit Sub

            End If

    End If

    Cells(saerchRow, 注文番号列).Value = 注文番号

 End Sub
(no_name) 2022/06/10(金) 13:48

コード部分だけあげなおします

 Sub test(品目番号, 注文番号)

    On Error Resume Next

            saerchRow = WorksheetFunction.Match(品目番号, Range(Cells(1, 品目番号列), _
                                                                Cells(Cells(Rows.Count, 品目番号列).End(xlUp).Row, 品目番号列)), 0)              
    On Error GoTo 0

    If saerchRow = 0 Then

       Debug.Print "「" & 品目番号 & "」はありませんでした。" 

       Exit Sub

    End If

    If Cells(saerchRow, 注文番号列).Value <> "" Then

            On Error Resume Next

                    saerchRow = WorksheetFunction.Match(品目番号,Range(Cells(saerchRow + 1, 品目番号列), _
      Cells(Cells(Rows.Count, 品目番号列).End(xlUp).Row, 品目番号列)), 0)

            On Error GoTo 0

            If saerchRow = 0 Then

                    Debug.Print "「" & 品目番号 & "」はありませんでした。" 

                    Exit Sub

            End If

    End If

    Cells(saerchRow, 注文番号列).Value = 注文番号

 End Sub
(no_name) 2022/06/10(金) 13:50

 Cells(saerchRow, 注文番号列).Value = 注文番号
          ↑
     このsaerchRowは2回めのsaerchRowの値

 2回目の saerchRow の値に、1回目の saerchRow の値を加算しないといけないですね
(´・ω・`) 2022/06/10(金) 14:01

´・ω・` さん

アドバイスありがとうございます.
Match関数は検索範囲の先頭を1として値が出力されることを失念しておりました.

´・ω・` さんのコードを少し改造して思い通りの処理ができるようになりました.
アドバイスをくれた皆さんありがとうございます.

下記にコードを残します.

Function LastMatch(ByVal searchKey As Variant, ByVal targetRange As Range, 注文番号列 As Long) As Variant

   Dim n As Long, i As Long
   Set targetRange = targetRange.Columns(1)

   n = WorksheetFunction.CountIf(targetRange, searchKey)

   On Error Resume Next
      i = WorksheetFunction.Match(searchKey, targetRange, 0)
   On Error GoTo 0

   Select Case n

      Case 0
         LastMatch = 0 ''返り値 0 としこのメソッド呼び出したモジュール内でエラー処理
      Case 1
         LastMatch = i
      Case Else

         '' 注文番号欄に値が入っていれば次の行から再検索
         If IPcls.ws.Cells(i, 注文番号列).Value <> "" Then 

            Set targetRange = targetRange.Resize(targetRange.Cells.Count - i).Offset(i)

            LastMatch = i + LastMatch(searchKey, targetRange, 注文番号列)

         Else

            LastMatch = i

         End If

   End Select

 End Function

(no_name) 2022/06/10(金) 14:34


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.