VBA　条件付き書式設定について

VBAでエクセルの条件付き書式設定をしたいのですがなかなかうまくいきません。

セルE5〜F74に数字をいれています。
これと、X95〜X125に含む数字を比較し、セルE5〜F74に同じ文字が含まれていたらセルの色を変えたいのです。

sub 条件付き書式設定（）
If Range（"E5:E74"）Value=（"X95:X125"&"*"）Value
frm Setting Interior=RGB（204,204,504）
End If
End Sub

としましたが、全くだめでした。
今日初めたばかりの超ど素人です。

アドバイスお願いします。

radames1000

2020/07/07 23:56

手動で希望の条件付き書式の設定はできますか？それが出来ればマクロの記録で解決すると思います。

mattuwan

2020/07/09 04:40

>セルE5〜F74に数字をいれています。 >これと、X95〜X125に含む数字を比較 >セルE5〜F74に同じ文字が含まれていたら数値として比較するのではなく、文字としてあいまい検索をするのでしょうか？例があると回答側もイメージしやすいです。

gom-49

2020/07/09 20:02

説明不足で申し訳ありません。例を以下の通り記載しました。よろしくお願いします。例　部品の仕様を比較します。セルE5 DC110V,赤色セルE74 AC220V,緑色セルF5 3000A,その他仕様セルF74 5000A,その他仕様と記載しています。セルX95 DC110V セルX100 DC200V セルX125 3000A です。セルX95〜X125までの文字列がセルE5〜E74,F5〜F74に含まれているか調べたいのです。調べて該当するセルの色をかえたい。条件付き書式設定ですればいいのですが、VBAで作りたいのですがいくら作ってもうまくいきません。セルの完全一致ではなく、部分一致です。なので、ワイルドカード　”*”を使おうとしました。

radames1000

2020/07/10 05:16

「条件付き書式」設定と書いてますが、エクセルの「条件付き書式」機能を使いたいわけじゃなく、VBAで値を判断して色を付けたいんですよね。きっと。

行動規範の内容に同意します

回答2件

ベストアンサー

希望している結果はこの様なものですか。
(Excel画面からの条件付き書式内容）

VBAでのコードは下記になります。

VBA
1Sub Test_Sample_Miniature()
2    Dim MyRange As Range
3    Dim MyAddr As String
4    Dim MyFormat As String
5    For Each MyRange In Range("E5:E74")
6        MyAddr = MyRange.Address
7        MyFormat = "=ISERROR(VLOOKUP(" & MyAddr & ",$X$95:$X$125,1,FALSE))=FALSE"
8        MyRange.FormatConditions.Add Type:=xlExpression, Formula1:=MyFormat
9        MyRange.FormatConditions(1).SetFirstPriority
10        MyRange.FormatConditions(1).Interior.Color = RGB(204, 204, 255)
11    Next
12End Sub

参考Url:https://teratail.com/questions/267033

(追記)
基準セル値の中の一部一致で結果を返す事は関数では難しい様に思えます。
(データベース関数を使えば出来るのでしょうか････？)
VBAでユーザー関数を作りましたので、これを標準モジュールへ貼り付けてVLOOKUPをVlookupRevMatchに入れ替えて動かして見て下さい。

VBA
1Option Explicit
2Function VlookupRevMatch( _
3ByRef 検索値 As Range, _
4ByRef 範囲 As Range, _
5ByVal 列番号 As Integer, _
6ByVal 検索方法 As Boolean _
7) As Variant
8    Application.Volatile
9    Dim MyRange As Range
10    Dim blnError As Boolean: blnError = True
11    For Each MyRange In 範囲
12        If InStr(検索値, MyRange) <> 0 Then
13            VlookupRevMatch = MyRange
14            blnError = False
15            Exit For
16        End If
17    Next
18    If blnError = True Then VlookupRevMatch = CVErr(xlErrNA)
19End Function