リストにある文字が検索列にあれば印

質問

A列にリストがあり、C列のセル内に
リストの5桁の数字があれば、C列にチェック（字を赤くするなど）が入り確認が可能になるマクロを組みたいです。下記はネットで探してきて、コピーして動かしたのですが、End ifに対するifがありませんが出て、その後Loopに対するForがありません、と出ました。
下記は合ってますか？

Sub Sample1()
Dim i As Long, k As Long, myStr As String
Dim myFound As Range, myFirst As Range
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
myStr = Cells(i, "A")
Set myFound = Range("C:C").Find(what:=myStr, LookIn:=xlValues, lookat:=xlPart)
If Not myFound Is Nothing Then
Set myFirst = myFound
GoTo 処理
Do
Set myFound = Range("C:C").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
For k = 1 To Len(myFound)
If Mid(myFound, k, Len(myStr)) = myStr Then
myFound.Characters(Start:=k, Length:=Len(myStr)).Font.ColorIndex = 3
End If
Next k
Loop
End If
Next i
End Sub

回答No.3

kkkkkm · ベストアンサー

回答No.1の補足です。

5桁の数字を探すとあったのでC列も数値と考えて元のコードにある一部分の色付けではなく数値の場合一部色付けはできないのでセル内全て色付けとしましたが

もしC列のデータが
ABC12345DFG
のように文字を含む数字で
探している数値のみ(12345なら上記の場合12345だけ)を色付けしたい場合には

myFound.Font.Color = vbRed
のところを
Call SetColor(myFound, myStr)
に変更して

End Sub

の後ろに以下を追加してください。

Private Function SetColor(ByRef myFound As Range, ByVal myStr As String)
Dim k As Long

For k = 1 To Len(myFound)
If Mid(myFound, k, Len(myStr)) = myStr Then
myFound.Characters(Start:=k, Length:=Len(myStr)).Font.Color = vbRed
End If
Next k
End Function

お礼

はい！完璧です、回答者さま！！ ですが、、、A1のセルに入れた値だけ、ヒットしません

Powered by GRATICA

補足

Call SetColor(myFownd,myStr)
に変えるとその下に書いたのが飛ばされて、追記した構文に飛びます最後、Next kまで綺麗にいき、繰り返しされます。。。

でも色はつかないです。

回答No.2

kkkkkm

質問の内容と外れて余計なお世話かもしれませんが

パソコンにWordが入っているのでしたらスマホ用のWordを入れて必要な部分をWordにコピペして
その後、パソコンとスマホをUSBケーブルでつないでパソコンから操作してスマホのWordのデータをパソコンにコピーし、Wrodの文書からエクセルにコピペしたらタイプするより早いような気がします。

もし興味がありましたら詳しいやり方はスマホかどこかのカテゴリで質問してください。

回答No.1

kkkkkm

以下でいいような気もします

Sub Test()
Dim i As Long, myStr As String
Dim myFound As Range
Dim firstAddress As String

For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
myStr = Cells(i, "A")
Set myFound = Range("C:C").Find(what:=myStr, LookIn:=xlValues, lookat:=xlPart)
If Not myFound Is Nothing Then
firstAddress = myFound.Address
Do
myFound.Font.Color = vbRed
Set myFound = Range("C:C").FindNext(myFound)
Loop While Not myFound Is Nothing And myFound.Address <> firstAddress
End If
Next i
End Sub

お礼

順番が、、、逆になりましたが！！！

師匠のvba完璧すぎます！！！
A1は、タイトル行でした。

2行目から、、i はじまってますもんね！

勉強不足です。
考えてくださった文に、どういう意味か、メモ書きして勉強します。

お金払うくらいのレベルのものを作っていただき、大変ありがとうございました🙇‍♀️

補足

ありがとうございます！！
私には、、仕事しかないんですけど
パソコン遅くて、、、
人間関係も、苦手で、、

なのに仕事だけ年数がたってるから多いんです。

こなさないと

とにかく
おばさんができない、できないってイライラしてたら、、かっこ悪いし誰もわかってくれないから、、

最近見つけた、、マクロを、、、なんて便利なんだと！！！

でも、私できません。。

いつもあなたが答えてくれるので、、、、また、試します

ぽちぽち打ちし、、、

家の古いパソコンで。ネットにも繋がってません。
こんな私が人の手を借りて、、、

乗りこえようだなんて、、、

でもなんか行き詰まりです。