エクセルのマクロで

質問

エクセルのマクロで自動で記録させることしかできないド素人です。マクロで置換をしたいのですが、普通の置換ではなく例えば一枚目のシートのあるセルに花子さん、２枚目シートのあるセルに太郎さん、そのとなりのセルに次郎さんというようになっていたとします。これをマクロで花子さんを置換して太郎さんとその隣に次郎さんもくるようにしたいのですが可能でしょうか。または置換だと1つのセルに対して２つのセルは無理かもしれないので、ある条件の時に（太郎さんの時に）隣に次郎さんが貼り付けられるようにする方法はありますか。今までは手動で花子さんのところに太郎、次郎の両方のセルをコピーで貼り付けていました。これを多数の置換を登録してマクロにすればとても便利なのですがこのようなことは可能でしょうか。

回答No.3

Gody · ベストアンサー

指摘された、2箇所以上出てくる場合は前回投稿したもので考慮されています。Do～Loop文で繰り返し処理をしているので、見つからなくなるまでひたすら繰り返してくれます。実際に動かしてみるとちゃんと複数個置換されるはずです。（当方Excel2003で動作確認済みです。）蛇足ですが、2つ以上検索する場合でも、必ずしもFindNextを使う必要はありません。速度面ではちゃんと現在のセルを指定して、それ以降を検索させた方が速いのかもしれませんが、初心者の方ということでしたので、いろいろ使うと混乱されるかと思ったので……。

さて、プロシージャの意味が分からない、とのことですが、マクロの記録をして、中のコードをのぞくと

Sub Macro1()
　　' この間に何かいろいろ書いてある
End Sub

こんな感じの場所があると思いますが、プロシージャとはこの Sub～End Sub で囲まれた1かたまりのものです。実行する時にはこの間に書かれた処理が上から順に実行され、End Subまで到達すると終了となります。

つまり複数のパターンを使い分けたい、という場合はどうすればいいのかというと、

Sub Macro1()
　　’パターン1の処理
End Sub

Sub Macro2()
　　’パターン2の処理
End Sub
...

というふうに書いていって、「マクロの実行」で実行するマクロを選ぶときに、Macro1を選べばパターン1が実行されます。同様に、Macro2を選べばパターン2が実行されます。
なお、Sub Macro1()のMacro1の部分はマクロの名前ですので、ご自分の分かりやすい名前にしておくとよいでしょう。

説明があまり上手くなくて申し訳ないです。以上、ご理解のお役に立てば幸いです。

回答No.6

at121

多数の置換を登録してマクロ・・多数の置換を登録した表に対応するマクロ

準備　　　シート　（置き換え表）　に
　A列：変換語句　B列：置き換え語句　C列：右隣　置き換え語句　を用意する。
例　A列　　B列　　C列
　　花子　太郎　　次郎
　　あゆ　マリ　　
操作　　シート　置き換え表　で置き換え項目を確認したら　マクロ実行
動作　　置き換え表から起動したことを確認し
　置き換え表の　A列語句を順次　全て　読み込み
　全シート（置き換え表を除く）に対して
　　A列：変換語句　を検索し　
　　　　該当セルを　B列：置き換え　語句に置き換え
　　　　　C列：置き換え語句がある場合　は　右隣も　置き換え（上書き）

　　　　　※B列　が　空白の場合　空白を書き込む。
　　　　　※C列　が　空白の場合　右隣セルにはなにもしない。

↓マクロモジュールにコピー↓
Sub 置き換え表⇒全シート一括置き換え()
Dim 変換対象セル As Range
If Not (ActiveSheet.Name = "置き換え表") Then Exit Sub
'置き換え表（A列：変換語句　B列：置き換え　C列：右隣　置き換え
For Each 変換語句セル In Range("A:A").SpecialCells(xlCellTypeConstants) '置き換え表

検索語句 = 変換語句セル.Value

For Each シート In Worksheets '全シート

If Not (シート.Name = "置き換え表") Then

シート.Cells.Replace What:=検索語句, Replacement:="$$&&&&$$", LookAt:=xlWhole 'ダミー
'同一語句変換無限ループ回避　"$$&&&&$$"中間置き換え
Do While Not シート.UsedRange.Find(What:="$$&&&&$$", LookAt:=xlWhole) Is Nothing
Set 変換対象セル = シート.UsedRange.Find(What:="$$&&&&$$", LookAt:=xlWhole)
変換対象セル = 変換語句セル.Offset(0, 1)
If Not IsEmpty(変換語句セル.Offset(0, 2)) Then '右隣のセル
変換対象セル.Offset(0, 1) = 変換語句セル.Offset(0, 2)
End If
Loop

End If

Next '全シート
Next '置き換え表

End Sub

回答No.5

KenKen_SP

#4 です。コードにミスがありました。すみません。
#4 を試す場合には、下記訂正をお願いします。

　　Set C = .Find( _
　　　　　　What:=strSearchKey, _
　　　　　　LookIn:=xlValues, _
　　　　　　LookAt:=xlWhole, _
　　　　　　SearchOrder:=xlByRows, _
　　　　　　MatchByte:=False)

の部分を下記に差替え

　　Set C = rngSA.Find( _
　　　　　　What:=strSearchKey, _
　　　　　　LookIn:=xlValues, _
　　　　　　LookAt:=xlWhole, _
　　　　　　SearchOrder:=xlByRows, _
　　　　　　MatchByte:=False)

回答No.4

KenKen_SP

こんにちは。KenKen_SP です。

理解しやすいように、検索し見つかったセルの値を直接書き換えています。

Sub Sample()

　　Dim strSearchKey As String
　　Dim rngSA As Range
　　Dim C As Range

　　'【Findメソッド】（HELP抜粋）
　　'指定されたセル範囲の中で特定の情報を検索し、情報が見つかった
　　'最初のセル (Range オブジェクト) を返します。
　　'検索の条件にあてはまるセルが見つからなかった場合は、Nothing
　　'を返します。

　　'検索する語
　　strSearchKey = "花子さん"
　　'指定されたセル範囲＝検索範囲はここで指定
　　Set rngSA = ActiveSheet.UsedRange

　　'検索を実行して見つかれば、変数 C に最初のセルが返される
　　'※　FindメソッドはWhat以外の下記オプションを保持するから
　　'　できれば明示した方が良い
　　Set C = .Find( _
　　　　　　What:=strSearchKey, _
　　　　　　LookIn:=xlValues, _
　　　　　　LookAt:=xlWhole, _
　　　　　　SearchOrder:=xlByRows, _
　　　　　　MatchByte:=False)
　　'変数C が Nothing で「なければ」＝＞ 見つかったセルがある
　　If Not C Is Nothing Then
　　　　'変数C が Nothing になるまでループ
　　　　Do

　　　　　　'↓ここに見つかったセルに対する処理を書き込む
　　　　　　'------------------------------------------------
　　　　　　'見つかったセルの値を書き換え
　　　　　　C.Value = "太郎さん"
　　　　　　'見つかったセルのひとつ横のセルを書き換え
　　　　　　'OFFSET でセルをずらしているがIV列を超えるとエラー
　　　　　　'になる可能性がある
　　　　　　On Error Resume Next
　　　　　　　　C.Offset(0, 1).Value = "次郎さん"
　　　　　　On Error GoTo 0
　　　　　　'------------------------------------------------

　　　　　　'次を検索
　　　　　　Set C = rngSA.FindNext(C)
　　　　Loop Until C Is Nothing
　　End If

　　'オブジェクト変数開放
　　Set C = Nothing
　　Set rngSA = Nothing

End Sub

Gody さんへ

#1 の On Error GoTo ～ の例外処理だと例えば今回の場合、IV列に
「花子さん」があった場合、PasteSpecial でエラーが発生し、そこで
処理が停止してしまいそうです。

回答No.2

imogasi

＞一枚目のシートのあるセルに花子さん
花子さんは２箇所以上出てくる可能性は考えなくてよいのですか。既回答だと１つしか検索しないのでは。２つ以上あると、FindされたActiveCellの後をFindNextする必要があるのではないでしょうか。

お礼

あ、説明不足ですみません。花子さんは２箇所以上複数でてきます。宜しくお願い致します。

回答No.1

Gody

置換では1つのセルに対してしか操作できない（少なくとも私の知る範囲では）ので、「花子さん」を検索した後、そのセルと隣のセルを書き換える処理をしてあげることになります。

なお、一枚目のシートは"sheet1"、
二枚目のシートは"sheet2"、
太郎さん、次郎さんのセルはsheet2のA1、B1と仮定して進めます。

' まず、太郎さんと次郎さんをコピーしておきます。
Sheets("sheet2").Activate
Range("A1:B1").Copy

' エラー処理です。以降、エラーが出たら終了します
' （見つからなくなったらエラーが出るため）
On Error GoTo NotFind

' "花子さん"を繰り返し検索して貼り付けます。
Sheets("sheet1").Activate
Do
　　Cells.Find("花子さん", LookIn:=xlValues, LookAt:=xlWhole).PasteSpecial
Loop

NotFind:
　　On Error GoTo 0
　　Exit Sub

以上のような文でとりあえず可能だと思います。
太郎さん、次郎さんのセルも場所が決まってない、という場合でしたら、
Range("A1:B1").Copy
の部分を
Cells.Find("太郎さん", LookIn:=xlValues, LookAt:=xlWhole).Range(Cells(1, 1), Cells(1, 2)).Copy
に変えてあげればよいでしょう。

あと、多数の置換を登録してマクロにしたい、ということですが、とりあえずは値を変えたものを別のプロシージャにすればよいと思います。

長文、失礼しました。

お礼

あ、ありがとうございます！まさにこれだと思います（まだ試してないのですが）。でもこれは自動の記録ではなく編集をしないといけないんですね...チャレンジしてみます。また最後の別のプロシージャ～というのがちょっと分からないのですが、どういうふうにすればよいのでしょうか？