| |
これでどうでしょーか ? A:H列のみ検索します。
Private Sub CommandButton1_Click()
Dim FR As Range
Dim Ad As String, i As Integer
Dim ObjRE As Object, Matches As Object, Match As Object
With ActiveSheet
If .ProtectContents Then .Unprotect
.UsedRange.Font.ColorIndex = xlColorIndexAutoMatic
End With
Range("A15000").Value = 読み仮名.Text
Range("B15000").Value = 接頭語.Text
Range("C15000").Value = 化合物名.Text
Range("D15000").Value = 包装.Text
Range("E15000").Value = 単位.Text
Range("F15000").Value = 本数.Text
Range("G15000").Value = 特記事項.Text
Range("H15000").Value = 保管場所.Text
Range("A7:H15000").Sort Key1:=Range("A7"), Order1:=xlAscending, _
Key2:=Range("C7"), Order2:=xlAscending, Key3:=Range("B7"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Set FR = Range("A:H").Find("*有害*", , xlValues)
If FR Is Nothing Then
MsgBox "検索値 [有害] は見つかりません", 64
Exit Sub
Else
Ad = FR.Address
End If
Set ObjRE = CreateObject("VBScript.RegExp")
With ObjRE
.Pattern = "[有害]"
.Global = True
End With
Do
Set FR = Range("A:H").FindNext(FR)
Set Matches = ObjRE.Execute(FR.Value)
For Each Match In Matches
i = Match.FirstIndex + 1
FR.Characters(i, 1).Font.ColorIndex = 3
Next
Set Matches = Nothing
Loop Until FR.Address = Ad
Set FR = Nothing: Set ObjRE = Nothing
End Sub
|
|
Kein
- 03/12/18(木) 11:40 -
