Excel VBA 質問スレ Part79(ﾜｯﾁｮｲあり)

[1 デフォルトの名無しさん (ﾜｯﾁｮｲ aaa4-I2zm) 2023/01/28(土) 12:12:12.41 ID:UjlIZ1Ov0]

!extend:checked:vvvvv:1000:512
!extend:checked:vvvvv:1000:512
↑同じ内容を3行貼り付けること

ExcelのVBAに関する質問スレ
コード書き込みや作成依頼もOK

次スレは>>980が立てること
無理なら細かく安価指定

※前スレ
Excel VBA 質問スレ Part77
https://mevius.2ch.net/test/read.cgi/tech/1658009255/
Excel VBA 質問スレ Part78
https://mevius.2ch.net/test/read.cgi/tech/1667104996/

---

VIPQ2_EXTDAT: checked:vvvvv:1000:512:: EXT was configured

[109 デフォルトの名無しさん (ﾜｯﾁｮｲ fd49-BTrK) 2023/02/18(土) 11:21:39.71 ID:wyxXLbRL0]

>>108
コードを書いてみた。
所定のフォントを変えた後、最後にまとめて「あ」を空白に置換させている。

Sub findあ()
　Dim foundcell As Range, firstcell As Range, target As Range, Num As Long, flag As Boolean
　Set foundcell = Cells.find(What:="あ")
　If foundcell Is Nothing Then Exit Sub
　　Set firstcell = foundcell:Set target = foundcell
　　Do
　　　Num = InStr(foundcell, "あ")
　　　If Num > 1 Then
　　　　flag = False
Do
If flag = False Then Num = 0
Num = InStr(Num + 1, foundcell, "あ")
If Num = 0 Then Exit Do
foundcell.Characters(Start:=Num - 1, Length:=1).Font.Name = "BIZ UDゴシック"：flag = True
Loop
End If
Set target = Union(target, foundcell)
Set foundcell = Cells.FindNext(foundcell)
Loop Until foundcell.Address = firstcell.Address
target.Replace What:="あ", Replacement:=""
End Sub

[110 109 (ﾜｯﾁｮｲ fd49-H4qV) 2023/02/18(土) 11:39:38.68 ID:wyxXLbRL0]

途中で書き込んでしまったので
もし使うならインデント調整して下さい