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

測試並為我工作。 祝好運 ：）