[[20230303102208]] 『検索値の右隣の値を転記したい』(検索) ページの最後に飛ぶ

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

 

『検索値の右隣の値を転記したい』(検索)

こんにちは

登録用というシートのA2から下に検索値が入っています。検索値の右隣B列には
必ず個数(数字)が入っています。

ここで検索値を別ブックのB列から探し出しあったら、あった場所から右に4つ目
の箇所に転記するマクロを作成しました。
現状のマクロは
検索値が転記されてしまいます。
これを検索値ではなくその右隣の個数(数字)を転記するにはどう修正したらよいでしょうか?
Sub test()
Dim 検索値 As String

        Dim MyRNG As Range
        Dim SH As Worksheet  
        Dim row As Integer
        row = 2 '2行目から

        Do Until ThisWorkbook.Worksheets("登録用").Cells(row, 1).Value = "" 'A列2行目から開始して空白になるまで
        検索値 = ThisWorkbook.Worksheets("登録用").Cells(row, 1) 'B列
        '
        Set SH = wbSaki.Sheets(1)
        SH.Range("AB6").AutoFilter 28, ThisWorkbook.Worksheets("登録用").Range("J2:J3") 'AB6(上位品番)でフィルター設定
        SH.Range("AE6").AutoFilter 31, ThisWorkbook.Worksheets("登録用").Range("K2:K3") 'AE6(投入工程)でフィルター設定
        Set MyRNG = SH.Range("B:B").Find(What:=検索値, After:=SH.Cells(SH.Rows.Count, "B"), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious) '下から上で検索
        If Not MyRNG Is Nothing Then '見つかった場合
        With wbSaki.Sheets(1)
           .Cells(MyRNG, 4) = 検索値

        End With
End Sub

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 試してないけどこんな感じでいかが?
    Sub test()
        Dim 検索セル As Range
        Dim ws登録用 As Worksheet
        Dim wbSaki As Workbook
        Dim MyRNG As Range
        Dim SH As Worksheet
        Dim irow As Integer
        irow = 2 '2行目から
        Set ws登録用 = ws登録用
        Do Until ws登録用.Cells(irow, 1).Value = "" 'A列2行目から開始して空白になるまで
            Set 検索セル = ws登録用.Cells(irow, "A")
            '
            With wbSaki.Sheets(1)
                .Range("AB6").AutoFilter 28, ws登録用.Range("J2:J3") 'AB6(上位品番)でフィルター設定
                .Range("AE6").AutoFilter 31, ws登録用.Range("K2:K3") 'AE6(投入工程)でフィルター設定
                Set MyRNG = .Range("B:B").Find(What:=検索セル.Value, _
                                               After:=.Cells(SH.Rows.Count, "B"), _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchDirection:=xlPrevious) '下から上で検索
                If Not MyRNG Is Nothing Then '見つかった場合
                   .Cells(MyRNG.row, 4) = 検索セル.Offset(, 1).Value '右隣のセル 二つとなりなら.Offset(,2)
                End If
            End With
            irow = irow + 1 '次の行
        Loop
    End Sub

(稲葉) 2023/03/03(金) 10:40:50


>あった場所から右に4つ目の箇所
 MyRange.Offset(,4)
とかでしょうか?

(abc) 2023/03/03(金) 10:55:40


 あ、Afterのところ、差し替えお願いします。
 After:=.Cells(SH.Rows.Count, "B"), _
              ~~~
 After:=.Cells(.Rows.Count, "B"), _

 っと読み違えてた!?
 >これを検索値ではなくその右隣の個数(数字)を転記するにはどう修正
 こっちが主眼かと思ったんですが・・・
(稲葉) 2023/03/03(金) 10:57:19

稲葉様のコードを少し修正して、無事にできました。
ありがとうございました。
(検索) 2023/03/03(金) 11:03:29

コメント返信:

[ 一覧(最新更新順) ]


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