将单元格中的数组与国家代码列表进行比较

Question

一系列单元格的当前单元格输入是国家代码，如下所示例如。NL-UK-FR-BR-

我有一个包含国家代码的列表，每次单元格发生更改时，我都会尝试检查它是否只包含列表中的国家代码(中间有分隔符(。

由于蒂姆的建议，我有以下代码：

Sub ProcessThree(Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
'1. replace the wrong seperators
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " / ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " . ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " , ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " : ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace " ; ", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace "  ", " - "
'symbols entered without space
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace "/", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ".", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ",", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ":", " - "
ActiveSheet.Range("B199:B218,B223:B242,B247:B261,B266:B275").Replace ";", " - "

'2. Split cell based on seperator
Dim arr() As String
arr = Split(Target, " - ")
Dim countrycode As Variant
For Each countrycode In arr
MsgBox countrycode
Next

End Sub

暂时停留在比赛部分。

我有两个问题。当我收到消息框时，是否不可能在for each之外显示整个数组，例如ER-DE=>它为每个国家代码显示两次消息框，这正常吗？关于如何将数组与国家代码列表/范围相匹配，有人有一个很好的例子吗？提前谢谢，我刚开始的时候已经好多了。

Answer 1

试试这个：

Private Sub Worksheet_Change(ByVal Target As Range)
Const THE_RANGE = "B199:B218,B223:B242,B247:B261,B266:B275"
Const SEP As String = "-"

Dim c As Range, arr, s As String, e, v, rngList As Range, msg As String

If Target.Cells.Count > 1 Then Exit Sub 'single-cell updates only

'is the change in the range of interest?
Set c = Application.Intersect(Target, Me.Range(THE_RANGE))
If c Is Nothing Then Exit Sub 'no intersect

v = Trim(UCase(c.Value))      'trim and upper-case the user-entered value
If Len(v) = 0 Then Exit Sub   'no content

'normalize to wanted separator
For Each e In Array("/", ".", ",", ":", ";", " ")
v = Replace(v, e, SEP)
Next e

Set rngList = ThisWorkbook.Sheets("Lists").Range("A1:A20") 'for example
arr = Split(v, SEP)

For Each e In arr
e = Trim(e)
If Len(e) > 0 Then
'is this code in the list
If IsError(Application.Match(e, rngList, 0)) Then
msg = msg & IIf(Len(msg) > 0, vbLf, "") & e 'add to error message
Else
'don't add items already added
If Instr(SEP & s & SEP, e) = 0 Then
s = s & IIf(Len(s) > 0, SEP, "") & e  'goes back into cell...
End If
End If
End If
Next e
Application.EnableEvents = False  'don't re-trigger the event...
Target.Value = s
Application.EnableEvents = True

'any codes removed?
If Len(msg) > 0 Then
MsgBox "The following country codes are not valid:" & vbLf & msg, vbExclamation
End If
End Sub