String 基于VBA的Excel数据验证

我正在寻找有关创建sub的帮助，该sub根据不同工作表C、D、E列“映射”中列出的可能值对工作表“比较”中C列中的值进行数据验证。我希望可能的值使用字符串/模式字符，如#？*使数据验证更加灵活。可能有1到5个不同的可能值，这些值因键而异。验证差异将在工作表比较中的空列D中显示

这里，一个包含数据的示例可能最有帮助

Static sheet 'mapping' . Key is Column A. Possible values in Columns C onwards
A               B               C               D               E               F               G
v1              CDID            ####            ###?            0
c52             FHAID           ER#             EP#             INVA            Z*              
c48             PLID            *
v24             CUSTID          ###             ###Q            ###P
c22             MATID           ???#            ??#             ?#
q23             LKKID           *


Input original sheet 'Compare'. Key is Column B. Column C contains Data to validate
A               B               C               D
c22             MATID           RT3FG
v24             CUSTID          456P
v1              CDID            5   
q23             LKKID           PORTA

Output sheet 'Compare'. Invalid values noted in Column D.
    A               B               C               D
c22             MATID           RT3FG           Error: Invalid value
v24             CUSTID          456P
v1              CDID            5               Error: Invalid Value    
q23             LKKID           PORTA

你有什么想法可以让它工作吗？比较工作表的所有数据都以A1开头，没有标题。映射表将非常大，有100多行，可能需要vlookup或类似的工具才能找到正确的行。

假设*是任何东西#是一个数字和？这是我想到的一个字符

Sub CompareToMapping()
   Dim mapSheet As Worksheet: Set mapSheet = Sheets("Mapping")
   Dim compSheet As Worksheet: Set compSheet = Sheets("Compare")
   Dim mcell As Range
   Dim ccell As Range
   Dim rcell As Range

   'Loop throw all the rows in the compare sheet
   For Each ccell In compSheet.Range("a1", compSheet.Range("a" & compSheet.Rows.Count).End(xlUp))
      'loop through and find a matching row from Mapping sheet
      For Each mcell In mapSheet.Range("a1", mapSheet.Range("a" & mapSheet.Rows.Count).End(xlUp))
         If mcell = ccell And mcell.Offset(0, 1) = ccell.Offset(0, 1) Then
            'loop through valid format strings
            For Each rcell In mapSheet.Range(mcell, mapSheet.Cells(mcell.Row, mapSheet.Columns.Count).End(xlToLeft))
               ccell.Offset(0, 3) = "Error: Invalid value"
               If FormatCorrect(ccell.Offset(0, 2).Text, rcell.Offset(0, 2).Text) Then
                  'show error in column d
                  ccell.Offset(0, 3) = ""
                  Exit For
               End If
            Next rcell
            Exit For
         End If
      Next mcell
   Next ccell
End Sub

Function FormatCorrect(inString As String, inFormat As String) As Boolean
   Dim i As Integer: i = 0
   Dim curS, curF As String
   FormatCorrect = True

   ' first check for *
   If inFormat = "*" Then
      FormatCorrect = True
   ' next check if strings are the same length
   ElseIf Len(inString) <> Len(inFormat) Then
      FormatCorrect = False
   Else
      'compare 1 character at a time
      For i = 1 To Len(inString)
         curS = Mid(inString, i, 1)
         curF = Mid(inFormat, i, 1)
         If curF = "?" Then ' needs to be a letter
            If IsNumeric(curS) Then
               FormatCorrect = False
               Exit For
            End If
         ElseIf curF = "#" Then ' needs to be a number
            If Not IsNumeric(curS) Then
               FormatCorrect = False
               Exit For
            End If
         Else ' needs to be an exact match
            If curF <> curS Then
               FormatCorrect = False
               Exit For
            End If
         End If
      Next i
   End If
End Function

子比较映射（）
将地图图纸标注为工作表：设置地图图纸=图纸（“映射”）
将compSheet设置为工作表：设置compSheet=工作表（“比较”）
Dim mcell As范围
变暗ccell As范围
变暗rcell As范围
'循环抛出比较表中的所有行
对于compSheet.Range（“a1”、compSheet.Range（“a”和compSheet.Rows.Count）.End（xlUp））中的每个ccell
'循环并从映射表中查找匹配行
对于mapSheet.Range（“a1”、mapSheet.Range（“a”和mapSheet.Rows.Count）.End（xlUp））中的每个mcell
如果mcell=ccell且mcell.Offset（0，1）=ccell.Offset（0，1），则
'循环通过有效的格式字符串
对于mapSheet.Range（mcell、mapSheet.Cells（mcell.Row、mapSheet.Columns.Count）中的每个rcell.End（xlToLeft））
ccell.Offset（0，3）=“错误：无效值”
如果格式正确（ccell.Offset（0,2）.Text，rcell.Offset（0,2）.Text），则
'在d列中显示错误
中心偏移量（0，3）=“
退出
如果结束
下一个rcell
退出
如果结束
下一个麦克尔
下一个ccell
端接头
函数FormatCorrect（inString作为字符串，inFormat作为字符串）作为布尔值
尺寸i为整数：i=0
暗光标，curF作为字符串
FormatCorrect=True
“首先检查*
如果inFormat=“*”则
FormatCorrect=True
'下一步检查字符串的长度是否相同
那么，艾尔塞夫·莱恩（inString）莱恩（inFormat）呢
格式正确=错误
其他的
'一次比较一个字符
对于i=1至Len（安装）
curS=Mid（仪表，i，1）
curF=Mid（inFormat，i，1）
如果curF=“？”则“Then”需要是一个字母
如果是数字（curS），则
格式正确=错误
退出
如果结束
ElseIf curF=“#”Then”必须是一个数字
如果不是数字（curS），则
格式正确=错误
退出
如果结束
“Else”需要精确匹配
如果curF curS那么
格式正确=错误
退出
如果结束
如果结束
接下来我
如果结束
端函数

为我测试和工作。祝你好运：）

不确定这是否是最好（最有效）的方法，但我会这样实现：（1）B、C、d上的AlphaSort“映射”（2）B列上的AlphaSort“比较”（对于重复项）。（3.）将函数GetPatterns（ByVal strFromCompareColB As String）设为String（）-返回所有可能模式的数组。（4.）将CompareColC移动到memArray。（5.）对于memArray中的每个itemX和patternArray中的每个itemZ RegEx.Pattern=patternArray（i），如果不是RegEx.Test（itemX），则resultMemArray（）=“无效值”，下一个itemZ（Pattern），下一个itemX（memArray）。在末尾（6），CompareColD=resultMemArray