VBAのソースコードについて

Excelで、
選択したセル範囲内にある「 (」（スペースと半角のカッコの組み合わせ）で始まる文言に対して、
「 (」は「（」（全角カッコ）に、「)」（半角カッコ。スペースなし）は「）」（全角カッコ）に変換するアドインを作りたいと思っています。
そこでVBAのコードを書いているのですが、
上手くいきません。

以下がそのコードなのですが、
何が問題か教えていただけると嬉しいです（涙）
エラーは特に起こらないのですが、想定通りの挙動をせずに処理が終わってしまいます…

Option Explicit
Sub spacetoru_omojinisuru()
Dim i As Long, S As Long, E As Long, reg As Object
S = Selection(1).Column
E = Selection(Selection.Count).Column
Set reg = CreateObject("VBScript.RegExp")

With reg
.Pattern = "^[　 (]"
.IgnoreCase = False
.Global = True
End With

For i = Selection(1).Row To Selection(Selection.Count).Row

With Range(Cells(i, S), Cells(i, E))
.Replace What:="　 (", Replacement:="（", LookAt:=xlWhole
.Replace What:=")", Replacement:="）", LookAt:=xlWhole
End With

Next i

End Sub

質問者からの補足コメント

• コメント、ありがとうございます！（涙）
  「)」←この半角カッコの後ろには全角の漢字、ひらがな、カタカナのいずれかが入ります。空白が入ることはありません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/02/06 12:25

• お二方とも本当にありがとうございます＞＜
  xlPartに直し、さらに少しいじったところ、あともう少しというところまで来ました＞＜
  またさんの回答本当にありがたかったのですが何故か動かすことが出来ず。。。涙
  環境の問題なのか。。。素晴らしい回答なのに本当に申し訳ないです。。。
  
  やりたいこととしては「　 (りんご)」のような文言を「（りんご）」に直す
  アドインを作ることなのですが、以下のコードだと　 (は直るように
  なったのですが、)が直したくない箇所まで直ってしまいます。
  ※「(a)りんご」のような文言もあるのですが、そちらは直さずそのままにしたいのです。

  No.3の回答に寄せられた補足コメントです。 補足日時：2020/02/06 15:12

• Option Explicit
  Sub spacetoru_omojinisuru()
  Dim myRange As Range
  Dim i As Long, S As Long, E As Long
  Dim keyWord1 As String, keyWord2 As String
  Dim bool As Boolean
  S = Selection(1).Column
  E = Selection(Selection.Count).Column
  
  '選択範囲を 1 つずつループして処理する
  For i = Selection(1).Row To Selection(Selection.Count).Row
  Set myRange = Range(Cells(i, S), Cells(i, E))

    補足日時：2020/02/06 15:15

• With Range(Cells(i, S), Cells(i, E))
  keyWord1 = "?"　←ここが分かりません
  keyWord2 = "）"
  bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlPart)
  End With
  
  With Range(Cells(i, S), Cells(i, E))
  keyWord1 = "　 ("
  keyWord2 = "（"
  bool = myRange.Replace(keyWord1, keyWord2, LookAt:=xlPart)
  End With
  
  Next i
  
  End Sub

    補足日時：2020/02/06 15:18

• 補足が何個も分かれてしまいました…(；；)
  「ここが分かりません」と書いた箇所の正規表現がわからず…（涙）
  またソースの書き方はいまいちすぎると思うのでおいおい修正したいと思います…

    補足日時：2020/02/06 15:20

• ありがとうございます！！
  実は、やりたいこととしては「　 (りんご)」のような文言を「（りんご）」に直し、
  「(a)りんご」のような文言に対しては何もしない、という内容なのです。。。
  セルの途中でもこのように直って大丈夫です！！
  
  教えて頂いたコードだと「　 (りんご)」は正しく直るのですが、
  「(a)りんご」が「(a）りんご」のようにaの後のカッコが全角になってしまうのです。
  分かりづらくてすみません；；
  
  でも、教えて頂いたコードを応用して、最初書いたものよりスッキリしたコードに出来そうです！！
  ありがとうございます＾＾

  No.5の回答に寄せられた補足コメントです。 補足日時：2020/02/06 16:36

No.10 回答者： bonaron 回答日時： 2020/02/11 04:00

いろいろ制限が付きますが一応動作します。

Option Explicit
Sub spacetoru_omojinisuru()
　Dim rng As Range
　For Each rng In Selection
　　rng.Value = strKakko(rng)
　Next
End Sub

Private Function strKakko(Cell As Range) As String
　Dim strTmp As String
　Dim sta As Long
　Dim kokka As Long
　Dim kakko As Long

　strTmp = Cell.Value

　strTmp = Replace(strTmp, " (", "（")
　sta = Len(strTmp)

　Do While sta >= 2
　　kokka = InStrRev(strTmp, ")", sta, vbBinaryCompare)
　　If kokka > 0 Then
　　　kakko = InStrRev(strTmp, "(", kokka - 1, vbTextCompare)
　　　If kakko > 0 Then
　　　　If Mid(strTmp, kakko, 1) = "（" Then
　　　　　Mid(strTmp, kokka, 1) = "）"
　　　　End If
　　　End If
　　　sta = kakko - 1
　　Else
　　　sta = 0
　　End If
　Loop
　strKakko = strTmp
End Function

制限（とりあえず）
・Option Compare の指定をしないこと。
・括弧のネストには対応しない。
・セル結合は対応しない。
・若干の副作用あり。問題ないと思うけど。

No.9 回答者： Qchan1962 回答日時： 2020/02/08 12:29

#8 こんばんはは、無いですね。

変換ミスです。
インデント付けずに投稿してしまいました。読みにくくてすみません。

No.8 回答者： Qchan1962 回答日時： 2020/02/08 12:24

こんばんは、

なんかな～　すっきりしたコードにしたいと言う事でしょうか？ならば、無視してください。
難しい文字列には対応しないけど、例えば　「 (~~~ ( ^^)( (~)) ( ( (@@))（)」みたいな、

「 (りん(a)ご)りんご (ばなな)」こんな文字列なら、、大丈夫かと
あまり、難しく考えずに初心者上レベルで出来る方法で（手持ちのごちゃごちゃCSVの成型ファンクションを改造）
出来ればよいと言う事ではないかもですが、、、先のものはいづれもダメみたいなので。

Option Explicit
Sub StrRecTest()
Dim n As Long, j As Long
Dim strRec As String, Mystr As String
Dim flag As Boolean
strRec = Selection.Value
For n = 1 To Len(strRec)
Select Case Mid(strRec, n, 1)
Case " "
If Mid(strRec, n, 2) = " (" Then
Mystr = Mystr & Replace(Mid(strRec, n, 2), " (", "（")
n = n + 1
flag = True
j = 1
Else
Mystr = Mystr & Mid(strRec, n, 1)
End If
Case "("
If flag = True Then
j = j + 1
Mystr = Mystr & Mid(strRec, n, 1)
End If
Case ")"
If flag = True And j = 1 Then
Mystr = Mystr & Replace(Mid(strRec, n, 1), ")", "）")
flag = False
Else
Mystr = Mystr & Mid(strRec, n, 1)
j = j - 1
End If
Case Else
Mystr = Mystr & Mid(strRec, n, 1)
End Select
Next
Debug.Print Mystr
End Sub


ループやエラー処理、エラー対策はしていません。
特に　strRec = Selection.Valueなどは変更してください。

No.7 回答者： GooUserラック 回答日時： 2020/02/06 17:02

先ほどはすみませんでした。

こちらはいかがでしょうか？
※「りんご) (」のような物は対象外にするためいろいろしています。

Sub spacetoru_omojinisuru()

Dim 対象セル As Range
Dim 始 As Long
Dim 終 As Long
Dim 前 As String
Dim 中 As String
Dim 後 As String

　For Each 対象セル In Selection
　　始 = InStr(対象セル.Value, " (")
　　If 始 <> 0 Then
　　　終 = InStr(始, 対象セル.Value, ")")
　　　If 終 <> 0 Then
　　　　前 = Left(対象セル.Value, 始 - 2)
　　　　中 = Mid(対象セル.Value, 始 + 2, 終 - 始 - 2)
　　　　後 = Mid(対象セル.Value, 終 + 1)
　　　　対象セル.Value = 前 & "（" & 中 & "）" & 後
　　　End If
　　End If
　Next

End Sub

No.6 回答者： end-u 回答日時： 2020/02/06 16:43

「 (りんご)」→「（りんご）」

「 (りんご)みかん」→置換しない
ということでしょうか
つまり『左２文字が" ("』　かつ　『右１文字が")"』が条件ですか？

それとも
「 (りんご)みかん」→「（りんご)みかん」
この場合左2文字だけ置換？
つまり
『左２文字が" ("』→"（"
『右１文字が")"』→"）"
それぞれ単独でも置換しますか？
例えば以下は？
「 (りんご」→？
「りんご)」→？
「 (り(ん)ご)」→？



『左２文字が" ("』　かつ　『右１文字が")"』が条件で、左２文字と右１文字だけ置換するなら

reg.Pattern = "^( \()(.*)(\))$"
For Each r In rng
　　r.Value = reg.Replace(r.Value, "（$2）")
Next

な感じで、RangeのReplaceメソッドは使えず、セル単位で置換していくことになるかと思います
#DataObject使って文字列でまとめて置換して戻す..こともできなくもなさそうなんだけど面倒っぽい :|

No.5 回答者： GooUserラック 回答日時： 2020/02/06 16:21

No.4 お詫びなど

大変申し訳ございません。No.3へのお礼についてを見逃していました。
「 (」で始まる文言とは、セルの途中でも「 (」で始まり「)」終わる部分が有れば変換して良いのですよね？

No.4 回答者： GooUserラック 回答日時： 2020/02/06 16:12

もしかして単純に以下では何か問題がありますか？

Sub spacetoru_omojinisuru()

Dim 対象セル As Range

　For Each 対象セル In Selection
　　対象セル.Value = Replace(対象セル.Value, " (", "（")
　　対象セル.Value = Replace(対象セル.Value, ")", "）")
　Next

End Sub

No.3 回答者： end-u 回答日時： 2020/02/06 13:59

> 何が問題か

引数LookAtとRegExpの問題は既出で
それ以外だと引数MatchCaseも指定していないので半角全角区別していません

その他
・「 (」（スペースと半角のカッコの組み合わせ）で始まる文言に対して..という条件が考慮されていない
　（文言の途中に含まれている場合も変換対象になっている）
・Selectionはセルではない場合もあるからエラー対策必要
・Replaceは選択範囲に対して置換するから選択範囲を行単位でループしなくても良い
等々あります

『「 (」で始まる』という条件を満たさないといけないので、
A)セル単位で判定、セル単位で変換
B)セル単位で判定、（可能なら）後でまとめて変換
いずれにしてもセル単位で判定は必要ですよね

とりあえずB案
'セル選択の場合だけ処理
If TypeName(Selection) = "Range" Then
　　'判定範囲をできるだけ狭くしたい
　　Dim rng As Range
　　On Error Resume Next
　　Set rng = Intersect(ActiveSheet.UsedRange, Selection)
　　Set rng = rng.SpecialCells(xlCellTypeConstants, xlTextValues)
　　On Error GoTo 0

　　If Not rng Is Nothing Then
　　　　Dim Target As Range
　　　　Dim r As Range
　　　　For Each r In rng
　　　　　　If Left(r.Value, 2) = " (" Then
　　　　　　　　If Target Is Nothing Then
　　　　　　　　　　Set Target = r
　　　　　　　　Else
　　　　　　　　　　Set Target = Union(Target, r)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　'Unionでまとめた対象範囲に対してReplace
　　　　If Not Target Is Nothing Then
　　　　　　With Target
　　　　　　　　.Find "" '対象外置換バグ対策
　　　　　　　　.Replace What:=" (", Replacement:="（", LookAt:=xlPart, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
　　　　　　　　.Replace What:=")", Replacement:="）", LookAt:=xlPart, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
　　　　　　End With
　　　　End If
　　End If
End If

No.2 回答者： めぐみん_ 回答日時： 2020/02/06 13:37

これって正規表現は関係なくReplaceメソッドのLookAt:=が xlWhole ではなく xlPart なのでは？

すなわちセルにある値を完全一致で置換指定するのであれば、セルの値に置換対象以外の文字が存在しない場合にしか置換されないと思えます。

No.1 回答者： めぐみん_ 回答日時： 2020/02/06 12:14

どのような文字列に対して実行したいのかが不明ですかね。

特に

＞「)」（半角カッコ。スペースなし）は「）」（全角カッコ）に変換

半角カッコの後ろに空白がある場合とない場合が混在しているのかどうかです。