繰り返しの置き換えマクロで困っています。

質問

繰り返しの置き換えマクロで困っています。

マクロ初心者です。

aaa@bbb_123
111 112 33 240
111_15 220 245
bbb@ccc_111
111 22 33 260
11 220_40 270

上記の場合に、@行の次の行の一番最後の値に、プラス5して置き換えるマクロを作成したいです。

マクロを実行すると下記になる様にしたいです。（240が245、260が265）

aaa@bbb_123
111 112 33 245
111_15 220 245
bbb@ccc_111
111 22 33 265
11 220_40 270

@行の次の行の一番最後の値　と　プラス5
という形で置き換えしたいです。

どなたか、教えて頂けませんでしょうか

回答No.3

watabe007 · ベストアンサー

>一番最後の値に、プラス5して置き換
一番最後の値を５に置き換えていました
プラス５なら
Sub Test2()
　　Dim MyRng As Range
　　Dim FirstAddress As String　　
　　Dim v As Variant, i As Long

　　With Columns("A")
　　　　Set MyRng = .Find("@", LookIn:=xlValues, LookAt:=xlPart)
　　　　If MyRng Is Nothing Then Exit Sub
　　　　FirstAddress = MyRng.Address
　　　　Do
　　　　　　With MyRng.Offset(1)
　　　　　　　　v = Split(.Value, " ")
　　　　　　　　i = UBound(v)
　　　　　　　　v(i) = v(i) + 5
　　　　　　　　.Value = Join(v, " ")
　　　　　　End With
　　　　　　Set MyRng = .FindNext(MyRng)
　　　　Loop While FirstAddress <> MyRng.Address
　　End With
　　Set MyRng = Nothing
End Sub

お礼

ありがとうございました。
うまくいきました。大変に役にたちました。

回答No.4

Wendy02

#3さんのご指摘の「プラス５なら」、というのは確かに、質問はそうなのですが、その数字って、IP Address ですよね。桁の制限があるはずですね。そうでしたら、もう少し検証したほうがよいかもしれませんね。

'//
Sub TestMacro1()
　Dim c As Range
　Dim i As Long
　Application.ScreenUpdating = False
　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　If Cells(i, 1).Value Like "?*@*" Then
　　　 Cells(i + 1, 1).Value = NumberAdd(Cells(i + 1, 1).Value, 5)
　　　i = i + 1
　　End If
　Next
　Application.ScreenUpdating = True
End Sub
Private Function NumberAdd(ByVal sText As Variant, ByVal num As Long) As String
Dim i As Long
Dim buf As String
　 i = InStrRev(sText, Space(1), , 2)
　 If i > 1 Then
　　 buf = Trim(Mid$(sText, i))
　　 If IsNumeric(buf) Then
　　　 buf = buf + num
　　 End If
　　 NumberAdd = Mid(sText, 1, i) & buf
　 Else
　　 NumberAdd = sText
　 End If
End Function

お礼

ありがとうございました。
大変役に立ちました。

回答No.2

imogasi

必要要素技術はたいしたことなく少数なのに、丸投げしている。質問点を絞る訓練をしないと上達しません。
（１）@の在る行をどうして見つけるか
（２）次の行の捉え方
（３）文字列がスペースで区切られているから、それを分離し、最後の文字列を対称にする
（４）最後の捉え方
（５）数字文字列を数値化して、それに５を加え、また文字列に戻す方法。
（６）その他部分を一体化する方法
こういう風に考えるのだ。その中で判るものは除いて、WEB照会でもしてみる。
それから質問。
ーーー
（１）はFind、FindNextが初心者には難しいので、全データ行をInstr関数で＠が含まれて居るか
総なめしたほうがわかりやすいかと思う。
（２）はCellS()を使うと、Cells(r+1,"A")が次行
（３）Split関数を使う
（４）Ubound()の利用
（５）数値化はVAL（）、＋５は＋５
文字列に戻すのはCSTR関数
（６）は＆で結合
ーーー
Sub test01()
d = Range("A65536").End(xlUp).Row: MsgBox d
For i = 2 To d
a = Cells(i, "A")
p = InStr(a, "@")
If p <> 0 Then
MsgBox i
b = Cells(i + 1, "A"): MsgBox b
s = Split(b, " "): MsgBox s(UBound(s))

End If
Next i
End Sub
を実行して、質問のデータで、２，５となることを確認。
次の行のデータが正しく捉えていることを確認。
ーーー
Sub test01()
d = Range("A65536").End(xlUp).Row: MsgBox d
For i = 2 To d
a = Cells(i, "A")
p = InStr(a, "@")
If p <> 0 Then
MsgBox i
b = Cells(i + 1, "A"): MsgBox b
s = Split(b, " "):
c = s(UBound(s)): MsgBox c
c5 = Val(c) + 5: MsgBox c5
st = ""
For j = 0 To UBound(s) - 1
st = st & s(j) & " "
Next j
st = st & Str(c5): MsgBox st
End If
Next i
End Sub
ここでは存在チェックはしてません（次行など）
Str(c5)は符号桁１スペース入るかもしれないので、上記ではダメなら、正負にあわせて考えて追加してください。
納得後MSGBOXは削除。

お礼

ありがとうございました。
ひとつひとつ丁寧な説明で、とてもわかりやすかったです。
大変勉強になりました。

回答No.1

watabe007

データはA列に有るとしています
Sub Test()
　　Dim MyRng As Range
　　Dim FirstAddress As String

　　With Columns("A")
　　　　Set MyRng = .Find("@", LookIn:=xlValues, LookAt:=xlPart)
　　　　If MyRng Is Nothing Then Exit Sub
　　　　FirstAddress = MyRng.Address
　　　　Do
　　　　　　With MyRng.Offset(1)
　　　　　　　　.Value = Left(.Value, Len(.Value) - 1) & "5"
　　　　　　End With
　　　　　　Set MyRng = .FindNext(MyRng)
　　　　Loop While FirstAddress <> MyRng.Address
　　End With
　　Set MyRng = Nothing
End Sub