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

質問

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

http://okwave.jp/qa/q7563274.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学習中です。
何卒宜しくお願いいたします。

回答No.3

tom04 · ベストアンサー

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様

Selection.Resize(, Selection.Columns.Count + 48).Select
で、範囲を拡大したところ、無事入力成功いたしました！！！

ありがとうございました！！！
貴方は本当に素晴らしいプログラマーです！

また今後ＥＸＣＥＬでわからないことがございましたら、是非ともお助けくださいますとうれしい限りです。

ありがとうございました！

補足

tom04様

何度もありがとうございます。

行については、どこからどこまでと決定しているわけではありませんので、
[検索文字]で検索した位置からと考えておりました。

行については選択されるようですが、Ｃ列が丸ごと開いてしまっておりまして、そこで止まっておりました。
Ａ列に関しては、[検索文字]から下に番号で文字が埋まります。

実際に表を見ていただければ、「あーこれですか笑」ってわかっていただけそうなんですが、
データ自体が、機密性が高いもので、なかなかでき無いのです…
（今年中になんとかしないといけない、大流行のものです）

回答No.4

tom04

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

回答No.2

tom04

こんにちは！

操作するのは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

補足

毎回お返事くださいまして誠にありがとうございます。

重大な見落としをしておりまして、CurrentRegionでは、Ｃ列のセルが空で横が全て選択されませんでした；；

横はAX列までございます。

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

でよろしいでしょうか？

もう一歩な気がしております。

いろいろと穴のある前提条件ですみませんけれども、何卒宜しくお願いいたします。

回答No.1

keithin

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

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

補足

ご回答くださり誠にありがとうございます。

なぜか、インデックスが有効な範囲にありません
Set target = Worksheets("auD").Cells.Find(what:=h1, LookIn:=xlValue, lookat:=xlWhole)
と出ます。

おそらく、範囲の指定に私の前提が漏れていたのだと思います。
誠に申し訳ございません。
スクリプトは是非とも今後のご参考にさせていただきたく存じます。

誠にありがとうございます。