エクセルのvbaによる書式のコピーについて

こんにちは｡

Vlookupでは書式("_"下線)が反映されず､vbaのfindメソッドで書式ごとコピーをすればいいというのはわかったのですが､難解でお力を貸して頂きたく質問をさせて頂きました｡

やりたいことは､

シート１
A1：y_u

をシート２のA1でも同様に表記されるようにしたいです｡

もし可能でしたら､y(o)uをy_uにするといった()内のものを置き換える？方法も教えて頂けると幸いです｡

No.1 回答者： tom04 回答日時： 2016/07/11 16:48

こんにちは！

前半部分の質問がイマイチ判らないので、後半部分だけです。
↓のコードをコピー＆ペーストしマクロを実行してみてください。

Sub Sample1() 'この行から//
ActiveSheet.Cells.Replace what:="(?)", replacement:="_", lookat:=xlPart
End Sub 'この行まで//

※　とりあえず()の中は一文字限定としています。
複数文字も対応したい場合は
＞what:="(?)"
を
＞what:="(*)"
としてみてください。m(_ _)m

No.2 回答者： WindFaller 回答日時： 2016/07/13 00:07

Vlookup から、Findメソッドという振り出しをさせると、私には良く分からなくなります。

両者の類似点というものが、私にはあまりないと思うからです。

>vbaのfindメソッドで書式ごとコピーをすればいいというのはわかったのですが
理屈としては、まさにそのとおりには違いないのですが、Excelのメソッドにあるようでいて、ないのです。Pastespecial でいくつか試しにやってみるとうまく行きません。

(1)
そこで、やはり丸ごとコピーということになります。
(途中から下線というようなスタイルの場合にはできないということです）
検索語に、マウスカーソルを置いて実行します。

(2)の方は、
最初に検索するセルにマウスカーソルを置いて、右隣に()で置き換わる文字を書いておきます。A1 が検索語なら、B1 が置換文字です。
y(o) u　または、y* // _

マクロを実行します。
現在のマクロはただの一回きりです。連続置換の場合は、コードを書き換えなくてはなりません。

'//
''(1)
Sub SerchReplacement()
Dim c As Range
Dim FirstAddress As String
Dim r As Range
Set r = ActiveCell
If r.Value = "" Then Exit Sub
With Cells
Set c = .Find(What:=r.Value, After:=r, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
　SearchDirection:=xlNext)
　　 If Not c Is Nothing Then
　　　　 r.Copy
　　　　 c.PasteSpecial (xlPasteAll)
　　　　 Application.CutCopyMode = False
　　 End If
End With
End Sub



'//
''(2)
Sub SerchReplacement2()
Dim c As Range
Dim Re As Object
Dim FirstAddress As String
Dim r As Range
Dim replTxt As String
Dim Matches
Dim a As Variant
Set Re = CreateObject("VBScript.RegExp")
Re.Pattern = "(\(.*\))"
Re.Global = False
Set r = ActiveCell
replTxt = ActiveCell.Offset(, 1).Value '括弧の中だけ
If r.Value = "" Then Exit Sub
With Worksheets("Sheet2").Cells
Set c = .Find(What:=r.Value, After:=r, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
　SearchDirection:=xlNext)
　　 If Not c Is Nothing Then
　　　　Set Matches = Re.Execute(c.Value)
　　　　If Matches Is Nothing Then
　　　　　　 MsgBox "括弧が見つかりません。"
　　　　Else
　　　　　　a = c.Value
　　　　　　c.Value = Replace(c.Value, Matches(0).subMatches(0), replTxt, , 1, vbTextCompare)
　　　　　　 If a <> c.Value Then Beep
　　　　 End If
　　　　End If
End With
　　Set Re = Nothing
End Sub


なお、Basp21というオブジェクトライブラリが入れてあれば、もっと簡単に置換が出来ます。