下記のマクロはC列5行目から文字の

質問

下記のマクロはC列5行目から文字の入っている最後の行までの範囲で
セル内に蜜柑や林檎、苺の文字が入っていたら同一行のA列にも蜜、林、苺
の文字を入れるというマクロなのですが・・・
たとえばC列12行目が

『蜜柑林檎苺』

となっていた場合、A列に入る言葉は『苺』となり『蜜』『林』という言葉が
消えてしまいます。
そこでこのマクロを少し改造して、
C列が『蜜柑林檎苺』や『蜜柑苺』となっている場合
A列に入る言葉は『蜜林苺』ないし『蜜苺』という風に積み重ねていくように改造はできないでしょうか？
↓この部分を改造すればできるようになりますか？
Cells(i, 2).Offset(0, -1).Value = "蜜"

Sub 蜜柑林檎苺()
Dim i As Long
With ActiveSheet
For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row

If InStr(.Cells(i, "C"), "蜜柑") > 0 Then
MsgBox i & "行目アウト！"
Cells(i, 2).Offset(0, -1).Value = "蜜"
End If

If InStr(.Cells(i, "C"), "林檎") > 0 Then
MsgBox i & "行目アウト！"
Cells(i, 2).Offset(0, -1).Value = "林"
End If

If InStr(.Cells(i, "C"), "苺") > 0 Then
MsgBox i & "行目アウト！"
Cells(i, 2).Offset(0, -1).Value = "苺"
End If

Next i
End With
End Sub

回答No.1

mshr1962 · ベストアンサー

式の一部ですが．．．

Cells(i, 2).Offset(0, -1).Value = "林"
↓
Cells(i, 2).Offset(0, -1).Value = Cells(i, 2).Offset(0, -1).Value & "林"

Cells(i, 2).Offset(0, -1).Value = "苺"
↓
Cells(i, 2).Offset(0, -1).Value = Cells(i, 2).Offset(0, -1).Value & "苺"

でいいのでは？

回答No.2

n-jun

Sub　test()
　Dim　Reg　As　Object
　Dim　st　As　String
　Dim　v　As　Variant,　i　As　Long
　Dim　match　As　Variant,　matches　As　Variant

　Set　Reg　=　CreateObject("VBScript.RegExp")
　　　　　Reg.Pattern　=　"蜜柑|林檎|苺"
　　　　　Reg.Global　=　True
　v　=　Range("C5",　Cells(Rows.Count,　3).End(xlUp)).Value

　For　i　=　1　To　UBound(v,　1)
　　　　　st　=　""
　　　　　If　Reg.test(v(i,　1))　Then
　　　　　　　　Set　matches　=　Reg.Execute(v(i,　1))
　　　　　　　　For　Each　match　In　matches
　　　　　　　　　　　　st　=　st　&　Left(match.Value,　1)
　　　　　　　　Next
　　　　　End　If
　　　　　Range("A"　&　i　+　4).Value　=　st
　Next
　Set　Reg　=　Nothing
　Erase　v
End　Sub
例えばこうゆう感じの事ですか。