初めて質問せて頂ます
指定した文字だけを変更することは可能なのですが
セル内にある指定した文字全部の色が変わらなくて困っています
マクロ初心者なもので大体インターネットから拾ってきたものをつなぎ合わせて使う程度の能力です
どなたか教えていただけませんでしょうか?
ちなみに「質問No.2769123」を参考にしましたがセルに含まれる文字は1つしか色が変わりません
例)セル内に指定した文字が10個あった場合全部色を変えたいと思っています
1つのセル内の文字「ABCD、ABCD、ABCD、ABCD、ABCD、ABBA、ABCD、ABBA、ABBA、ABCD…」
上記の場合ABBAの文字を全部赤に変えたいといった感じです
どうかよろしくお願いいたします
経緯としては検索した文字がヒットしたらその文字の色を変更したいと思ったからです
No.1ベストアンサー
- 回答日時:
リンクなど貼ってもらえたら有難いです。
とりあえず、そのまま引用させてもらうと
Sub Macro1()
Dim rng As Range
Dim ptr As Integer
Const tStr As String = "ABC" 'ここに色を変える文字列を書く
For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23)
ptr = InStr(rng.Value, tStr)
If ptr > 0 Then
rng.Characters(Start:=ptr, Length:=Len(tStr)).Font.ColorIndex = 3
End If
Next rng
End Sub
ですよね??
Instr というのは、中に文字列が含まれているかどうかを検索するものです。
この場合だと、含まれていたら、1回だけ実行するようなプログラムになっています。
そのセルに何度も含まれている場合は、ptrの部分も含め
繰り返す必要があります。
Sub Macro1()
Dim rng As Range
Dim ptr As Integer
Dim StartRange As Long
Const tStr As String = "ABBA" 'ここに色を変える文字列を書く
For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23)
StartRange = 1
Do
ptr = InStr(StartRange, rng.Value, tStr)'StartRangeの位置から、検索文字があるかどうか判別。
StartRange = ptr'検索後、StartRangeを更新する
If ptr > 0 Then
rng.Characters(Start:=StartRange, Length:=Len(tStr)).Font.ColorIndex = 3
StartRange = StartRange + Len(tStr)
End If
Loop Until ptr <= 0
Next rng
End Sub
んー、こんな感じでしょうか?(上手くいくかは不安ですが)
StartRangeというのは、セル内の検索位置になります。
satoron666様
大変ありがとうございました
おかげで全部色が付きました
自分でもなんとかさっき作成できたのですが
スマートじゃなく動作も遅かったので教えて頂いたものがとても良く感謝しております
以下自分が実際に使ったものです
tStr = Trim(Replace(FindWord, "*", " ")) 'ここに色を変える文字列を書く
tStr = Split(tStr, " ")
For Each rng In Sheets("検索結果").Cells.SpecialCells(xlCellTypeConstants, 23)
StartRange = 1
Do
For i = LBound(tStr) To UBound(tStr)
ptr = InStr(rng.Value, tStr(i))
ptr = InStr(StartRange, rng.Value, tStr(i)) 'StartRangeの位置から、検索文字があるかどうか判別。
StartRange = ptr '検索後、StartRangeを更新する
If ptr > 0 Then
rng.Characters(Start:=StartRange, Length:=Len(tStr(i))).Font.ColorIndex = 3
StartRange = StartRange + Len(tStr(i))
End If
Next
Loop Until ptr <= 0
Next rng
私が試行錯誤した微妙なものです>w<
' Dim N As Integer
' Dim M As Integer
' tStr = Trim(Replace(FindWord, "*", " ")) 'ここに色を変える文字列を書く
' tStr = Split(tStr, " ")
' For Each rng In Sheets("検索結果").Cells.SpecialCells(xlCellTypeConstants, 23)
' For i = LBound(tStr) To UBound(tStr)
' ptr = InStr(rng.Value, tStr(i))
' If ptr > 0 Then
' For N = 1 To Len(rng.Text)
' For A = 0 To UBound(tStr)
' If Mid(rng.Text, N, Len(tStr(i))) = tStr(A) Then
' rng.Characters(Start:=N, Length:=Len(tStr(i))).Font.ColorIndex = 3
' End If
' Next A
' Next N
' End If
' Next i
' Next rng
No.2
- 回答日時:
基本的なものは以下になると思います
Public Sub Samp1()
Dim r As Range
Dim sS As String, sW As String
Dim iPos As Long
sS = "ABBA"
For Each r In Range("A1:A1000")
sW = r.Value
iPos = 1
Do While (iPos < Len(sW))
iPos = InStr(iPos, sW, sS)
If (iPos = 0) Then Exit Do
r.Characters(iPos, Len(sS)).Font.ColorIndex = 3
iPos = iPos + Len(sS)
Loop
Next
End Sub
InStr をヘルプで見てみると、1つ目の引数は何文字目から探すか・・・
なので、1文字目から探して・・・あったらその位置が返ってくるので
その位置から、検索文字数分の色を指定・・・
次を探す時には、その位置に検索文字数を加算した所から・・・
上記、検索文字 "ABBA" で、見つかった位置が 2 なら、次は 2 + 4 = 6 文字目から
> 経緯としては検索した文字がヒットしたらその文字の色を変更したい
事をやってみると、雰囲気以下に
Public Sub Samp2()
Dim r As Range
Dim sAddr As String
Dim sS As String, sW As String
Dim iPos As Long
sS = "ABBA"
Set r = Cells.Find(sS, LookAt:=xlPart)
If (Not r Is Nothing) Then
sAddr = r.Address
Do
sW = r.Value
iPos = 1
Do While (iPos < Len(sW))
iPos = InStr(iPos, sW, sS)
If (iPos = 0) Then Exit Do
r.Characters(iPos, Len(sS)).Font.ColorIndex = 3
iPos = iPos + Len(sS)
Loop
Set r = Cells.FindNext(r)
Loop While (r.Address <> sAddr)
End If
End Sub
今見ているシート全体を対象に、部分一致で検索し、なければ終わり・・・
あればセルのアドレスを覚えておいて、色付け処理
次のを求めて、覚えていたアドレスと同じなら処理を抜ける
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(Microsoft Office) Excelの条件付き書式についての質問です。 2 2022/09/08 01:25
- Excel(エクセル) エクセルの数式で教えてください。 1 2023/02/08 09:05
- Excel(エクセル) エクセルの数式で教えてください。 2 2023/02/10 11:41
- Excel(エクセル) エクセルの条件付き書式で*を使いたい 4 2022/05/13 16:49
- Excel(エクセル) マクロ、条件付き書式のfont.color 1 2023/03/28 01:10
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/12/26 12:05
- Visual Basic(VBA) 特定の文字を簡単な操作で半角スペースに変換するか削除したい 2 2022/11/01 10:35
- Visual Basic(VBA) 指定した文字から指定した文字のスペースまでを削除するVBAの構文について 6 2022/07/24 22:20
- Excel(エクセル) エクセルの数式で教えてください。 1 2023/02/15 08:30
- Excel(エクセル) Excel VBAで、行の高さを、上下1文字分程度高くしたい 3 2023/04/23 00:17
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
文字の色が黒から青になる
-
VBAにてデータが数字か文字...
-
エクセルの特定の太文字が入力...
-
Excelの吹き出し等の文字を検索...
-
グレーの文字
-
イラストレーター、オブジェク...
-
イラストレーターで将棋の駒の...
-
Word2007 文字色が勝手に変わっ...
-
四字熟語?故事成語?ことわざ?
-
Shuriken Pro4の受信メールの...
-
HPビルダーで文字の囲み線
-
イラストレーターで文字を入力...
-
特定の文字を入れるとセルの色...
-
印刷に使用する文字の色について
-
サクラエディタのコメントに色...
-
エクセル条件付き 色付け
-
写真内の文字を消すにはどうし...
-
全角ファイル名検索
-
Wordでこのような三角が出てく...
-
ワードに「URL」を貼り付けると...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
サクラエディタのコメントに色...
-
エクセルの特定の太文字が入力...
-
写真内の文字を消すにはどうし...
-
Excel ハイフンより前の数字だ...
-
文字の色が黒から青になる
-
エクセルで、大文字小文字を区...
-
GIMPでの縦書きを横に戻す方法
-
Word2007 文字色が勝手に変わっ...
-
イラストレーター、オブジェク...
-
VBAにてデータが数字か文字...
-
Excelの吹き出し等の文字を検索...
-
QRコードってなくならないので...
-
グレーの文字
-
Photoshop 文字に下線を入れる...
-
iPhoneでgooや各種ウェブサイト...
-
エクセルでメールアドレスの最...
-
印刷に使用する文字の色について
-
セルに色つけたら文字の部分が...
-
エクセル テキスト中一部の文...
-
HPビルダーで文字の囲み線
おすすめ情報