VBA Excel数据验证

Question

I was looking for some help on creating a sub which does data validation on the values in column C in a worksheet 'Compare' based on possible values listed in a different worksheet 'mapping' in columns C, D, E etc. I wanted to have the possible values use string/pattern characters like # ? * to make the data validation more flexible. There could be anywhere from 1 to 5+ different possible values which varies by key. Validation differences would be spit into an empty column D in worksheet Compare.

An Example with Data is likely most helpful here.

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

Any ideas on how to make this work? Compare worksheet will have all data starting in A1 with no headers. mapping sheet will be quite large with 100+ rows and probably requires a vlookup or similar to find correct row.

Answer 1

Assuming * is anything # is a number and ? is a char I came up with this

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

Tested and worked for me. Good luck :)