アプリ版:「スタンプのみでお礼する」機能のリリースについて

下記のマクロは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

A 回答 (2件)

式の一部ですが...



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 & "苺"

でいいのでは?
    • good
    • 0

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
例えばこうゆう感じの事ですか。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!