Excel : テキストボックス中のテキストの検索・置換

質問

Excelの図として貼り付けたテキストボックスにテキストが入力されていて、そのテキストボックスが数十個、シートに貼り付けられています。またそれが30シートくらいあります。

このたくさんのテキストボックスに入力されたテキストを複数のシートに渡って一括置換する方法はありませんでしょうか。

回答No.5

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

ちょっとお話に興味があって、あえて修正版を作りました。

しょせん、Undoの仕組みというのは、どこかにバッファを置いているだけだと思うのです。私は、この手のものは、時々、Undoに代わるものを作ります。前のは、手抜きでしたから、今度は、もう少し手の込んだものを作りました。

通常は、VBAプロシージャで、すべてのUndoを考えていたら、VBA側に与えられているメモリは小さいので、それを食いつぶしてしまう可能性があります。

以下は、配列変数の一こまに、どの程度の許容量があるのか知りませんが、許容量を増やすなら、以下は、Logs の型をString 型すれば広がります。しかし、Null値を入れるために、Variant 型にしてあります。

String型の場合は、その代わりに、Chr(0)を入れればよいのですが。Null値のほうが簡単なのど、それを用いました。

'---------------------------------------------------------
'Option Explicit
Private Logs(100) As Variant

Sub ReplaceInTextBoxesR()
Dim shp As Object
Dim i As Integer
Const BEF As String = "あいうえお"　'検索後
Const AFT As String = "ABCDE"　'置換語

Const TX As Integer = vbTextCompare '全半角区別なし
Const BIN As Integer = vbBinaryCompare　'全半角区別あり

　For Each shp In ActiveSheet.Shapes
　If shp.Type = msoTextBox Then
　　Logs(i) = shp.DrawingObject.Text
　　shp.DrawingObject.Text = _
　　Replace(shp.DrawingObject.Text, BEF, AFT, , TX)　 '全角半角区別なし
　　i = i + 1
　End If
　Next
　Logs(i) = Null
　If MsgBox("これでよろしいですか？", vbQuestion + vbOKCancel) = vbCancel Then
　 Call UndoLogs
　End If
End Sub

Private Sub UndoLogs()
'一回きり、戻せます。
Dim shp As Variant
Dim i As Integer
　For Each shp In ActiveSheet.Shapes
　If shp.Type = msoTextBox Then
　　If IsNull(Logs(i)) Or IsEmpty(Logs(0)) Then Exit For
　　shp.DrawingObject.Text = Logs(i)
　　i = i + 1
　End If
　Next
Erase Logs
End Sub

お礼

修正版までありがとうございます。
月曜日に試してみたいと思います。(^^)

回答No.4

cthrough

#1です。

>元に戻せないことを強調

マクロの場合は、
間違った置換を行った場合は戻せませんよ(※)、
という意味合いでした、誤解を招き申し訳ないです。

※トレースジャーナルを持たない限り不可逆な置換である、と考えより
【ABCD】の【BC】を【CD】に変換しようとして【AB】を置換してしまったとしても
返還後の【CDCD】に無条件で【CD】を【AB】へ戻す処理を施しても
【ABAB】にしかならない
（“共有”ブックにある履歴を読み戻すイメージじゃない限り）

お礼

なるほど。
丁寧な説明ありがとうございました。

回答No.3

Wendy02

こんにちは。

#1の補足の、「残念ながら、マクロは使えません。」の意味が、マクロを使っていけないなら、諦めるしかありませんね。
それと、あまり、元に戻せないことを強調しているようなので、元に戻すオプションをつけてしまいました。

Const SW As Integer = 0 '順行 /0以外は、反転
は、簡単にいうと、=1 を入れれば、元に戻ります。

'-------------------------------------
'標準モジュールが適しています。

Sub ReplaceInTextBoxes()
Dim shp As Object
Const BEF As String = "abcdefg"　'検索後
Const AFT As String = "あいうえお"　'置換語

Const SW As Integer = 0 '順行 /0以外は、反転
Const TX As Integer = vbTextCompare '全半角区別なし
Const BIN As Integer = vbBinaryCompare　'全半角区別あり

Dim SWd As String
Dim RWd As String

If SW = 0 Then
　SWd = BEF: RWd = AFT
Else
　SWd = AFT: RWd = BEF
End If

　For Each shp In ActiveSheet.Shapes
　If shp.Type = msoTextBox Then
　　shp.DrawingObject.Text = _
　　Replace(shp.DrawingObject.Text, SWd, RWd, , , TX)　'全角半角区別なし
　End If
　Next
End Sub

お礼

誤解を招く表現で申し訳ございませんでした。
マクロを使っていけないということはありません。

元に戻すオプションまでつけて頂きありがとうございました。

回答No.2

ham_kamo

マクロで一括置換する方法です。

Alt+F11でVBAの画面を開き、左側のツリーからブック名を選択し、右クリックから「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。

Sub テキストボックス置換()
　Dim BeforeStr As String
　Dim AfterStr As String
　Dim WS As Worksheet
　Dim s As Shape

　Application.ScreenUpdating = False
　BeforeStr = InputBox("置換前の文字列を入力してください。")
　AfterStr = InputBox("置換後の文字列を入力してください。")
　For Each WS In Worksheets
　　WS.Activate
　　For Each s In WS.Shapes
　　　If s.Name Like "Text Box*" Then
　　　　s.Select
　　　　Selection.Characters.Text = _
　　　　Replace(Selection.Characters.Text, BeforeStr, AfterStr)
　　　End If
　　Next
　Next
　Application.ScreenUpdating = True
End Sub

その画面でF5キーを押すか、Alt+F11でExcelの画面に戻ってAlt+F8からマクロを実行してみてください。一度置換したら元には戻せないのでご注意ください。

お礼

わざわざマクロを作って頂きありがとうございました。

回答No.1

cthrough

通常の検索機能で検索・置換では
やはり変換は行えません。

質問者の方がマクロを使えれば
For EachをWorkSheetとShape(※)で
ネストさせながらReplaceを発行していけば
それほど複雑な制御なく置換(※※)が行えます。

※ShapeがTextBox以外ある場合はTextBoxを判定しないといけません
※※当然、マクロなのでUNDOはできません

お礼

ありがとうございます。
残念ながら、マクロは使えません。