どなたかマクロ修正お願いします。

質問

自分なりに　作成してみましたがどうもうまくいきません。

Sub 変換()

Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Dim r As Range
Set Sh1 = Worksheets("1")
Set Sh2 = Worksheets("2")
Set Sh3 = Worksheets("3")

Sh3.Select
Set c = Cells.Find(What:="9876543", LookAt:=xlWhole)
c.Offset(, 1).Activate
ActiveCell.Replace What:="中田", Replacement:="中田英寿"

End Sub

このように作成しましたがうまくいきません。恐らくsheet3のデータはsheet1から（　=1!A100 )といったように値を他のsheetから持ってきてるからではないんでしょうか？

回答No.7

Wendy02 · ベストアンサー

こんばんは。
Wendy02 です。

#6 さんの言葉を参考にさせていただきました。
＞３．=1!A100の式はそのまま生かし表示だけを"中田英寿"にしたいのでしょうか？

３のタイプで作ってみたものの、どうなのかなぁって思います。だいたい、Sheet名が、「1」 とか、「2」とか、特殊なものを作る、その分のエラー処理が増えます。一挙に複雑なコードになってしまいました。

Sub 変換Sample2()
　 Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
　 Dim c As Range, myNo As String, mySearch As String, myRep As String
　 Dim myFormula As String, strSh As String, strRng As String
　 Dim SheetFlg As Integer
　 myNo = "9876543"
　 mySearch = "中田"
　 myRep = "中田英寿"
　 Set Sh1 = Worksheets("1")　'必要あるのかな？
　 Set Sh2 = Worksheets("2")　'必要あるのかな？
　 Set Sh3 = Worksheets("3")
　 Sh3.Select
　 Set c = Cells.Find(What:=myNo, LookIn:=xlValues, LookAt:=xlWhole)
　 If c Is Nothing Then
　　　MsgBox myNo & " の番号が見つかりません。"
　　　Exit Sub
　 End If
　 With c.Offset(, 1)
　　　If .Value Like "*" & mySearch & "*" Then
　　　　 If .HasFormula Then
　　　　　　myFormula = .FormulaLocal
　　　　　　SheetFlg = InStr(myFormula, "='")
　　　　　　On Error GoTo ErrHandler
　　　　　　strSh = Mid$(myFormula, 2 + SheetFlg, _
　　　　　　Len(myFormula) - InStr(myFormula, "!") - 2-SheetFlg)
　　　　　　strRng = Mid$(myFormula, InStr(myFormula, "!") + 1)
　　　　　　Worksheets(strSh).Range(strRng).Value = myRep
　　　　　　Else
　　　　　　MsgBox " 番号の隣は、" & mySearch & "ではありません。"
　　　　　　GoTo ErrHandler
　　　　 End If
　　　End If
　 End With
ErrHandler:
　 If Err.Number > 0 Then
　　　MsgBox "数式の取得に失敗しました。", vbCritical
　 End If
　 Set Sh1 = Nothing: Set Sh2 = Nothing: Set Sh3 = Nothing
End Sub

回答No.6

g_nekoru

#2です。
１．結果としてどういう処理にしたいのでしょうか？
２．Sheet1の元データを変換したいのでしょうか？
それともsheet3の=1!A100の式を変換後の文字列で上書きしていいのでしょうか？
３．=1!A100の式はそのまま生かし表示だけを"中田英寿"にしたいのでしょうか？

２の場合は関数と文字が混在した列になってしまうのですが、今後内容が変わらず関数にしておく必要がないのであれば名前の列全体を実際の文字列に置き換えてはどうでしょうか？

３の場合は単なる応急処理になり後々を考えると面倒になりそうです。

回答No.5

at121

ステップで実行して　Set 発見セル＝・・の行を実行してからとめて　デバッグのイミディエイトで
？発見セル.Offset(, 1).Formula　　　とすると　"='1'!A100"　を得られる。
　"='1'!A100"　は　Replace　の置き換え対象の語句を含まない　ので　レンジに対する　Replace　では変換しない。
　発見セル.Offset(, 1).Replace What:="A100", LookAt:=xlpart,Replacement:="A101"　　とすれば式を変換する。
？発見セル.Offset(, 1).Value　で　"中田"　を得るのでセルのvalueを置き換える 。　　式：参照は破棄　なので表などが乱れる可能性があり　元を変換したほうが後腐れないかも。
参照元を辿って変換するなら　"='1'!A100"　でシート名、レンジを参照・・

Sub 変換()
Set Sh3 = Worksheets("3")
Set 発見セル = Sh3.Cells.Find(What:="9876543", LookAt:=xlWhole)
If Not 発見セル Is Nothing Then
セルの式の結果 = 発見セル.Offset(, 1).Value
発見セル.Offset(, 1) = Replace(セルの式の結果, "中田", "中田英寿")
End If
End Sub

回答No.4

imogasi

Sub 変換()

Dim Sh1 As Worksheet
Dim h2 As Worksheet
Dim Sh3 As Worksheet
Dim r As Range
Set Sh1 = Worksheets("sheet1")
Set Sh2 = Worksheets("sheet2")
Set Sh3 = Worksheets("sheet3")
Sh3.Select
Set c = Sh3.Cells.Find(What:="9876543", LookAt:=xlWhole)
c.Offset(, 1).Activate
ActiveCell.Replace What:="中田", Replacement:="中田英寿"

End Sub

9876543 中田を造って
実行すると
9876543 中田英寿
となり、うまくいきました。

回答No.3

Wendy02

こんばんは。Wendy02 です。

#2 さんのご指摘にもありますが、

Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Dim r As Range

行が赤くなってエラーが出て気が付くはずですが。
それから、r という変数は出てきませんね。

＞Set Sh1 = Worksheets("1")
　　・
　　・
確か、前回のお話では、「シートの何番目」という書き方をされていたと思いますが、もし、そうなら、そこは文字列ではありません。

Set c = Cells.Find(What:="9876543", LookAt:=xlWhole)
If Not c Is Nothing Then
　　c.Offset(, 1).Replace What:="中田", Replacement:="中田英寿"
End If

とぐらいは、エラー処理はしてもよさそうだと思いますね。

補足

いつもありがとうございます。
大変申し訳ないのですが、他のsheetから持ってきてるといううのは　”中田”　名前を( =1!A100 )といった感じにしており、その他のsheetから持ってきたデータを”中田英寿”といった感じに変換したいとおもっています。
すいませんが、よろしくお願いします。

回答No.2

g_nekoru

=1!A100でsheet1から持ってきているのは"9876543"の文字列ですよね？
それであれば問題なく動きます。

また、実際のシート名も"1"、"2"、"3"になっていますよね？

この記述で誤りがあるとすると最初のDim文でrの前に再びDimを記述している事くらいでしょうか？

実際のデータ形式が判らないのではっきりとは言えませんが自分で適当に入れたデータでは上記の点を修正すればちゃんと動作しました。

回答No.1

yambejp

Findの引数に「LookIn:=xlValues」とか
入れてみてはどうですか？