1233922310 <Excel 2000を使っています>


同一シート内にある文字複数の置換(マスキング)がしたいのですが良い方法が思いつきません。
Excelの標準機能の置換は試したのですが、複数には対応していないみたいで
良い方法を教えてください。

具体的には、

A列に

「NID ホームベビー 」 ← (NID)を置換→PB
「スマイル40EXマイルド」← (スマイル)を置換→PB
「MKM東洋化学)コフピタのどスプレー」(MKM)を置換して→PB
        ・
        ・
        ・etc(数百件)☆PBと置換したい対象の文字は、40件ほどあります。

宜しくお願い致します。

回答の条件
  • URL必須
  • 1人3回まで
  • 登録:2009/02/06 21:11:53
  • 終了:2009/02/10 21:43:44

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912009/02/07 00:44:08

ポイント50pt

(1)新しいシートを作成し、シート名を「変換表」としてください。

(2)変換表のA列に変換したい文字を順に記載ください。

(3)同シートのB列に変換後の対応する文字(すべて PB でしょうか?)を記載ください。

設定例)

NID PB
スマイル PB
MKM PB

下記のマクロを標準モジュール、Alt+F11で表示されるウィンドウで、「挿入」⇒「標準モジュール」

で表示される画面に張ってください。


変換したいセルの範囲を選択した状態で Alt+F8 を押し、slimer を実行してみてください。

Sub slimer()
    Dim r As Range
    Dim lastRow As Long
    
    lastRow = Worksheets("変換表").Range("A" & Rows.Count).End(xlUp).Row
    
    For Each r In Worksheets("変換表").Range("A1").Resize(1, lastRow)
        If Len(r.Value) > 0 And Len(r.Offset(0, 1).Value) > 0 Then
            Selection.Replace What:=r.Value, Replacement:=Len(r.Offset(0, 1).Value), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        End If
    Next
End Sub

http://www2s.biglobe.ne.jp/~iryo/vba/VBA02.html

id:chiroru-cyoko

Mook様

ご回答ありがとうございます。返事が遅くなってしまい申し訳ございません。

先ほど回答にしたが実行をしてみましたが、下記の所でエラーがでて

「中断モードを実行することはできません」

↓この記述が黄色く反転されています。

Selection.Replace What:=r.Value, Replacement:=Len(r.Offset(0, 1).Value), _

LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _

SearchFormat:=False, ReplaceFormat:=False

宜しくお願い致します。

2009/02/09 14:55:34

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/02/06 21:27:39

ポイント100pt

B列に置換対象の文字をいれておくと、A列をPBに置換するマクロです。

Option Explicit

Sub Macro1()
    Dim lastRow As Long
    Dim i As Long
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 1 To lastRow
        If Cells(i, 2).Value <> "" Then
            Columns(1).Replace What:=Cells(i, 2).Value, Replacement:="PB", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        End If
    Next i
End Sub

http://q.hatena.ne.jp/

id:chiroru-cyoko

ありがとうございます。

私の説明が足りないところがあったので、申し訳ございません。

実は、A列の対象の文字(一部をPBに変更して)

具体例

「NID ホームベビー 」置換 → 「PB ホームベビー 」

「スマイル40EXマイルド」置換→ 「PB40EXマイルド」

としたかったのです。

言葉足らずで申し訳ありません。

2009/02/07 00:01:02
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912009/02/07 00:44:08ここでベストアンサー

ポイント50pt

(1)新しいシートを作成し、シート名を「変換表」としてください。

(2)変換表のA列に変換したい文字を順に記載ください。

(3)同シートのB列に変換後の対応する文字(すべて PB でしょうか?)を記載ください。

設定例)

NID PB
スマイル PB
MKM PB

下記のマクロを標準モジュール、Alt+F11で表示されるウィンドウで、「挿入」⇒「標準モジュール」

で表示される画面に張ってください。


変換したいセルの範囲を選択した状態で Alt+F8 を押し、slimer を実行してみてください。

Sub slimer()
    Dim r As Range
    Dim lastRow As Long
    
    lastRow = Worksheets("変換表").Range("A" & Rows.Count).End(xlUp).Row
    
    For Each r In Worksheets("変換表").Range("A1").Resize(1, lastRow)
        If Len(r.Value) > 0 And Len(r.Offset(0, 1).Value) > 0 Then
            Selection.Replace What:=r.Value, Replacement:=Len(r.Offset(0, 1).Value), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        End If
    Next
End Sub

http://www2s.biglobe.ne.jp/~iryo/vba/VBA02.html

id:chiroru-cyoko

Mook様

ご回答ありがとうございます。返事が遅くなってしまい申し訳ございません。

先ほど回答にしたが実行をしてみましたが、下記の所でエラーがでて

「中断モードを実行することはできません」

↓この記述が黄色く反転されています。

Selection.Replace What:=r.Value, Replacement:=Len(r.Offset(0, 1).Value), _

LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _

SearchFormat:=False, ReplaceFormat:=False

宜しくお願い致します。

2009/02/09 14:55:34
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912009/02/09 15:48:17

ポイント50pt

コメントが無効でしたので、再回答で失礼します。

(コメント有効にしていただければ、不明な点はコメントにて補足いたします。)


コードに不備がありました。

            Selection.Replace What:=r.Value, Replacement:=Len(r.Offset(0, 1).Value), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

            Selection.Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

もしくは

            Selection.Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, LookAt:=xlPart

にして試してみていただけますか。

http://www.moug.net/tech/exvba/0050117.htm

id:chiroru-cyoko

Mook様

お世話になっております。

以下の記述でエラーはでなくなったのですが、うまく「PB」と変換されません。

1、新しいシート名を「変換表」を作成する。

2、「変換表」A列に「NID」「スマイル」「MKM 」と対称の文字をいれました。

3、「変換表」B列に「PB」をすべて入れました。

最初のシートに戻り

4、Alt+F8 を押し、slimer を実行をしました。

動いた様子はあるのですが、変換はされませんでした。

宜しくお願い致します。

Sub slimer()

Dim r As Range

Dim lastRow As Long

lastRow = Worksheets("変換表").Range("A" & Rows.Count).End(xlUp).Row

For Each r In Worksheets("変換表").Range("A1").Resize(1, lastRow)

If Len(r.Value) > 0 And Len(r.Offset(0, 1).Value) > 0 Then

Selection.Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, LookAt:=xlPart

End If

Next

End Sub

2009/02/09 16:36:45
  • id:Mook
    確認ですが、置換したい範囲を選択してから実行しているでしょうか。

    全部ではなく、選択範囲のみ置換する仕様となっています。
  • id:chiroru-cyoko
    Mook様
    いつもお世話になっております。

    置換したい範囲選択を選択しています。

    具体的には、初めの(変更表)ではないシートのA列を選択しています。
    画像を見てもらったりして方が良いと思うのですが、画像をアップできませんよね


    または、そのセルを見てもらいたいと思うのですが、
    どうしたら良いでしょうか?
  • id:SALINGER
    >言葉足らずで申し訳ありません。
    いえ、私のコメントにあるとおりに動くように作ってあります。
    B1に「NID」、B2に「スマイル」・・・のように書き込んで実行すれば意図した通りの動作をします。
  • id:Mook
    そうですね。SALINGER さんのも N対1対応の変換でであれば、問題なく動きそうな感じですね。


    私のに関して、もうひとつミスがありました。確認が甘くてすみません。
    For Each r In Worksheets("変換表").Range("A1").Resize(1, lastRow)

    For Each r In Worksheets("変換表").Range("A1").Resize(lastRow, 1)
    に変更ください。
    前回のものはA1のものは変換されたかなぁと思うのですが、それも動かなかったとしたら
    他に原因がありそうです。
  • id:chiroru-cyoko
    Mook様
    お世話になっております。

    以下の記述でマクロで動作しました。
    ありがとうございます。これで何千行のマスキングができるようになりました。

    SALINGER様の記述も合わせて使い分けて使わせて頂ければと思います。

    Sub slimer()
    Dim r As Range
    Dim lastRow As Long

    lastRow = Worksheets("変換表").Range("A" & Rows.Count).End(xlUp).Row

    For Each r In Worksheets("変換表").Range("A1").Resize(lastRow, 1)
    If Len(r.Value) > 0 And Len(r.Offset(0, 1).Value) > 0 Then
    Selection.Replace What:=r.Value, Replacement:=r.Offset(0, 1).Value, LookAt:=xlPart
    End If
    Next
    End Sub

  • id:chiroru-cyoko
    SALINGER様
    お世話になっております。

    Mook様の記述と使い分けてつかればと思っています。

    さきほど、もう一度SALINGER様記述で試したのですが、
    下記対象がオブジェクトエラーとなってしまい。
    先に進みません。

    宜しくお願い致します。


    Columns(1).Replace What:=Cells(i, 2).Value, Replacement:="PB", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
  • id:SALINGER
    私の環境ではできているので原因が分かりませんが、2行目と3行目は省略できるので1行目をxlPartまでにしておく。
    それで駄目ならエラーが出たときに、デバッグからiにカーソルを当ててiの値が何になっているかを見て教えてください。
  • id:chiroru-cyoko
    SALINGER様
    お世話になっております。

    もう一度確認をして実行しましたらうまく動くようになりました。
    ありがとうございました。

    エラーは、うまく貼付けができなかったのかなと思います。
    申し訳ございません。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません