VBAの入力規則のカンマ区切り,重複対応について

Question

お世話になっております。

なかなか、上手くいかず皆さんの知恵を貸してください。

【実現したいこと】
①VBAで、入力規則を設定したい
②入力規則に入れたいものの文字にカンマが入っている
③そのリストから重複を取り除きたい

例）
セルA1にapple,orange
セルB1にmelon
セルC1にmelon

この値をA2,A3,A4に適応させる場合

With Range("A2:A4").Validation
        .Delete
        .Add Type:=xlValidateList, _
             Operator:=xlEqual, _
             Formula1:="=$A1:$C1"
End With

上記のように、Formula1に範囲を指定した場合
重複した文字が入ってしまいます。

また、重複を取り除いた配列に変換させた場合
カンマ区切りを行うしかない（と思っています）ので
join(配列,",")のようにカンマ区切りとしてしまった場合

プルダウンのリストが
apple
orange
melon

とappleとorangeが分割されてしまい
どうすればいいか分からなかった為
質問させていただきました。

Answer 1

見かけが変わって良ければ「apple,orange」の部分を「apple-orange」に置換して登録し、選択されたときに「apple,orange」に変更してしまえば良いかと。

重複チェックについては、正規表現オブジェクトを使ってマッチングさせては？

A	B
apple,orange
melon
melon
lemon
apple,orange
lemon
```VBA
Function 重複チェック(source As String, data As String) As Boolean

Dim regObj As New RegExp

With regObj
    .Pattern = "(^|,)" & data & "(,|$)"
    .Global = True
End With
If regObj.Test(source) = True Then
    重複チェック = True
Else
    重複チェック = False
End If
Set regObj = Nothing

End Function

Sub 重複テスト()
Dim testData As String
Dim listData As String
Dim rowNum As Long

listData = ""

rowNum = 1
Do Until Cells(rowNum, 1).Value = ""
    testData = Replace(Cells(rowNum, 1).Value, ",", "-")
    If 重複チェック(listData, testData) = False Then
        If listData <> "" Then
            listData = listData & ","
        End If
        listData = listData & testData
    End If
    rowNum = rowNum + 1
Loop

Debug.Print listData

End Sub

### 結果
apple-orange,melon,lemon

Comments

[DreamTheater]

補足
「ツール」⇒「参照設定」で、Microsoft VBScript Regular Expressions 5.5をチェックしてください。