|
▼まさ さん:
おはようございます。
>お二方、早速のご提案ありがとうございます。
>しょっぱなから細かい条件を書くと、お伝えしにくいと思い
>省略した部分をさらに質問したいと思います。
これは、最初から記述してください。
だって、仕様が大きく違っていますからね!!
Chkvalueを以下のように変更しました。
'============================================================
Function chkvalue(rng As Range, ParamArray f_value()) As Variant
'機能 : 指定されたセル範囲に指定されたデータの有無を調査する
'入力 : rng --- 調査するセル範囲
' f_value()- 有無を調査するデータ群(3の倍数分の要素が必要)
' 連続する3つ要素をパックデータとします。第一、第二要素は検索データ
' 第三要素は△判定をするか否かのフラグ 0-△判定しない 1-△判定する
'出力 : chkvalue---○--f_value()の全てのデータがセル範囲に存在する
' △--f_value()のパックデータ第二、第一とこの純情で連続して存在した場合
' ×--f_value()の中の検索パックデータのいずれにも属さない場合
'記述例 : =chkvalue(a1:c3,1,2,0) セル範囲A1:C1の中に1,2の両方が1,2の順序で存在するか調査する
' =chkvalue(a1:c3,1,2,0,0,3,1)
' セル範囲A1:C1の中に1,2の両方が1,2の順序で存在するか調査する
' 又、0,3の両方が0,3の順序で存在するか調査し、且つ、3,0で連続して存在した場合は△判定とする
Dim idx As Long
chkvalue = "×"
Dim chkstr As Variant
chkstr = ""
For idx = 1 To rng.Count
chkstr = chkstr & "(" & rng.Cells(idx).Value & ")"
Next
' MsgBox chkstr
Dim regEx
Set regEx = CreateObject("VBScript.RegExp")
' 正規表現を作成します。
regEx.IgnoreCase = True ' 大文字と小文字を区別しないように設定します。
regEx.Global = True ' 文字列全体を検索するように設定します。
For idx = LBound(f_value()) To UBound(f_value()) Step 3
regEx.Pattern = "\(" & f_value(idx) & "\).*\(" & f_value(idx + 1) & "\).*"
' MsgBox regEx.Pattern
If regEx.test(chkstr) Then
chkvalue = "○"
Exit For
Else
If f_value(idx + 2) = 1 Then
regEx.Pattern = "\(" & f_value(idx + 1) & "\)\(" & f_value(idx) & "\).*"
If regEx.test(chkstr) Then
chkvalue = "△"
Exit For
End If
End If
End If
Next idx
Set regEx = Nothing
End Function
1 2 3
3 8 0
2 10 1
6 1 2
−1 1 0
0 1 8
30 50 0
このデータがセルA1からC7に入っていた時、
1と2は○
2と1は×
1と3は○
3と1は△
0と2は○
2と0は△
0と1は○
1と0は△
これ以外は×
という条件だとすると
「=chkvalue(A1:C1,1,2,0,1,3,1,0,1,1,0,2,1)」
なんて指定してフィル操作してください。
上記のデータの判定が
○
×
×
○
△
○
×
となります。
但し、セルにあるデータには数値という想定です。
確認してみてください。
|
|