[ExcelVBA]検索文字で検索し文字入力する

Question

いつもお世話になっております。
以前に投稿をさせていただきましたgitmykと申します。

http://oshiete.goo.ne.jp/qa/7563274.html

前回はご回答くださり誠にありがとうございます。
この場で感謝申し上げます。

内容を精査させていただきましたので、再度投稿させていただきます。

問題(1)
Sheet2のA列に[範囲指定文字]、B列に[検索文字]、C列に[入力文字]が複数入っている。
Sheet1を[範囲指定文字]で検索しCurrentRegionで範囲指定する。
範囲指定した全てのセルに対し、[検索文字]の上から順に検索していく。
該当セルがあれば、右4セルoffsetし、対応する[入力文字]を入力する。
（[検索文字]と[入力文字]は１対1で対応している）

問題(2)
Sheet2のA列に[範囲指定文字]、B列に[検索文字1]、C列に[検索文字2]、D列に[入力文字]が複数入っている。
Sheet1を[範囲指定文字]で検索しCurrentRegionで範囲指定する。
範囲指定した全てのセルに対し、[検索文字1]の上から順に検索していく。
該当セルがあれば、右2セル上1セルoffsetしたセルを対応する[検索文字2]で検索し、双方が一致した場合のみ[検索文字1]で検索した該当セルから、右に4セルoffsetしたセルに、対応する[入力文字]を入力する。
（[検索文字1]と[検索文字2]、[入力文字]は対応している）

問題(3)
Sheet1を[範囲指定文字]で検索し下に1セルoffsetした位置をCurrentRegionで範囲指定した場合。

上記内容をExcelVBAでどのように記載すればよいか、ご教授くださいませんでしょうか。

VBA学習中です。
何卒宜しくお願いいたします。

tom04 · Accepted Answer

No.2です。
補足を読ませていただきました。

最初の質問に
＞CurrentRegionで範囲指定する。
とありましたので、回答も　CurrentRegion　を使用しました。

範囲指定の列方向はAX列まであるというコトは判りましたが、
行方向はどこまでが範囲になるか決まっているのでしょうか？

仮に↓の画像で

Range("C6").CurrentRegion.Select

というマクロを実行すると
画像のように範囲指定されます。
（C6はB3～D12に変更しても範囲指定はすべて一緒です）

その辺が判るともっと具体的なアドバイスができると思うのですが・・・

次に
＞If r = ws.Cells(i, 2) Then '←ここに問題2の条件を「and」で付け加える
＞の部分は　　
＞If r = ws.Cells(i, 2) AND r.Offset(-1, 2) = ws.Cells(i, 3) Then
＞でよろしいでしょうか
に関してはおそらく大丈夫だと思います。

これも具体的な配置が判らないのでご自身でマクロを試してみて、もしダメなら
どのようにダメだったのかが判れば具体的なアドバイスはできると思います。

この程度でごめんなさいね。m（_ _）m

tom04 · Answer

No.2・3です。
＞行については選択されるようですが・・・
とありますので、
とりあえずAX列までやってみました。
問題1のコードです。

Sub test2()
    Dim i, j, k As Long
    Dim c As Range
    Dim ws1, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    For k = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In ws1.UsedRange
        If c = ws2.Cells(k, 1) Then
            c.CurrentRegion.Select
            For i = Selection(1).Row To Selection(Selection.Count).Row
            For j = Selection(1).Column To 50
                If ws1.Cells(i, j) = ws2.Cells(k, 2) Then
                    ws1.Cells(i, j).Offset(, 4) = ws2.Cells(k, 3)
                End If
            Next j
            Next i
        End If
    Next c
    Next k
End Sub

＞For i = Selection(1).Row To Selection(Selection.Count).Row
が行方向の範囲指定部になりますので、
問題3の
＞[範囲指定文字]で検索し下に1セルoffsetした位置・・・
に適応させたい場合は
＞For i = Selection(1).Row+1 To Selection(Selection.Count).Row+1
のようにすれば　CurrentRegion　で範囲指定された行全体が1行下がってLoopされます。
※　列方向に関しては　CurrentRegion　で範囲指定された最初の列～AX列までループさせています。
※　こんな感じではどうでしょうか？m（_ _）m

tom04 · Answer

こんにちは！

操作するのはSheet1で、Sheet2に検索文字等が入っているSheetとします。
Sheet2は1行目がタイトル行でデータは2行目以降にあるとして・・・

こういうコトですかね？
（問題1）のコードです

Sub test1()
    Dim i As Long
    Dim c, r As Range
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet2")
    For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Worksheets("Sheet1").UsedRange
        If c = ws.Cells(i, 1) Then
            c.CurrentRegion.Select  '←問題3はここを変更
            For Each r In Selection
            If r = ws.Cells(i, 2) Then  '←ここに問題2の条件を「and」で付け加える
                r.Offset(, 4) = ws.Cells(i, 3)
            End If
            Next r
        End If
    Next c
    Next i
End Sub

※　問題2に関してはほとんど同様のコードで、
コード内に載せてあるコメントの条件を付加すればOKだと思います。

※　問題3に関してはコードを
＞c.CurrentRegion.Offset(1).Select
としてはどうでしょうか？

内容を取り違えていたらごめんなさいね。m（_ _）m

keithin · Answer

sub macro1()
　dim h1 as range
　dim h2 as range
　dim target as range

’範囲指定文字の検索
　for each h1 in worksheets("Sheet2").range("A1:A" & worksheets("Sheet2").range("A65536").end(xlup).row)
　set target = worksheets("Sheet1").cells.find(what:=h1, lookin:=xlvalue, lookat:=xlwhole)
　if not target is nothing then
　set target = target.currentregion

for each h2 in target

’以下の部分が問題ごとのバリエーションなので、適切に検討してください。
　　if h2 = h1.offset(0, 1) then 
　　　h2.offset(0, 4) = h1.offset(0, 2)
　　end if

next
　end if
　next
end sub

問題３は通常意味のない指定なので、見直してください。

[ExcelVBA]検索文字で検索し文字入力する

No.2です。

この回答への補足

No.2・3です。

こんにちは！

この回答への補足

sub macro1()

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング