VBA Excel数据验证

Question

我正在寻找一些帮助，以创建一个子项，该子项基于C，D，E等不同工作表“映射”中列出的可能值，对工作表“比较”中C列的值进行数据验证。我想有可能的值使用字符串或模式字符，例如＃？ *使数据验证更加灵活。 可能存在1到5+个不同的可能值，具体取决于密钥。 验证差异将被吐入工作表Compare中的空列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或类似命令才能找到正确的行。

Answer 1

假设*是任何数字＃是数字并且是？ 是我想出的一个字符

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

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