如何验证 Excel VBA 中三列的层次结构

Question

我有一个excel；其中有两个 sheets:

第一个sheet是：'Jurisdictions' 其中包含三列：

国家（B 列）、州（C 列）和城市（D 列）

这个 sheet 每个城市都有一个条目。

但是，由于每个城市都列在单独的行中，州和国家/地区（城市所属的城市）的名称可能会在多行中重复。

例如：

U.S. --> New York --> Buffalo

U.S. --> New York --> Manhattan

（这是我的两行）

我还有一个 sheet: Sheet1;

这里我也有同样的三列；（以及其他 20 个专栏）

我将用 'Jurisdictions' sheet 中的三列验证这三列。（Sheet1 中只列出了少数 'Jurisdictions'；这些可以按任何顺序排列，也可以针对任何国家/地区）

验证规则是：

1) 对于国家

-- 国家名称只能是一个值。

-- 应与辖区 sheet 中 'Country' 列下的名称相匹配。

-- 忽略大小写(Uppercase/Lowercase)

2) 州

-- 只能用分号分隔一个或多个值（为了用分号分隔这些值，我编写了不同的代码并且工作正常）

-- 该单元格中的条目甚至可以是 'All'

-- 所有州名称都应与管辖权 sheet 的 'state' 列下列出的州相匹配。（如果列出了多个条目，则应首先根据分隔符-分号分隔这些条目，然后再进行比较）

-- 忽略大小写(Uppercase/Lowercase);州名前后多余的空格应该被删除。

3) 城市

-- 可以有一个或多个值，仅用分号分隔

-- 此单元格中的条目也可以是 'All'。

-- 所有城市名称都应与 Jurisdiction sheet 的 'City' 列下列出的城市相匹配。（如果列出了多个条目，则应首先根据分隔符-分号分隔这些条目，然后再进行比较）

-- 忽略大小写(Uppercase/Lowercase);州名前后多余的空格应该被删除。

我已经编写了验证单个列的代码。

但这还不够..!!!

我也必须验证层次结构..!!

即

U.S. --> New York --> Buffalo

U.S. --> New York --> Manhattan; Buffalo

India --> Karnataka;Maharashtra --> All

我为验证这些单独的列而编写的代码如下；

'********************************************************
'validate the 'Country' column in Sheet1, such that; It matches with one of the Country names and must exist
'********************************************************

    'Get the last row
    'Dim lastRow As Integer
    LastRow = Sheets("Sheet1").UsedRange.Rows.Count
    nLastRowSheet2 = Sheets("Jurisdictions").UsedRange.Rows.Count

    Dim c As Range

    'Turn screen updating off to speed up macro code.
    'User won't be able to see what the macro is doing, but it will run faster.
    Application.ScreenUpdating = False

    For Each c In Worksheets("Sheet1").Range("B2:B" & LastRow)
        Dim rngFnder As Range
        On Error Resume Next

            Set rngFnder = Sheets("Jurisdictions").Range("B2:B" & nLastRowSheet2).Find(c)

            If rngFnder Is Nothing Then
                c.Interior.Color = vbRed
            End If
        On Error GoTo 0
    Next


'********************************************************
'validate the 'State(multiples)' column in the Questions sheet, such that:
'-   State name matches with one of the state names or
'-   State name is set as 'All'
'********************************************************

    Dim stString As String
    Dim stArray() As String

    'Get the last row
    'Dim lastRow As Integer
    'LastRow = Sheets("Sheet1").UsedRange.Rows.Count
    'nLastRowSheet2 = Sheets("Jurisdictions").UsedRange.Rows.Count

    'Dim c As Range
    Dim d As Range
    Dim e As Variant

    For Each c In Worksheets("Sheet1").Range("C2:C" & LastRow)
        stString = c
        stArray() = Split(stString, ";")
        For Each e In stArray()
            e = Trim(e)

            'Dim rngFnder As Range
            On Error Resume Next

                Set rngFnder = Sheets("Jurisdictions").Range("C2:C" & nLastRowSheet2).Find(e)

                If rngFnder Is Nothing And c <> "All" Then
                    c.Interior.Color = vbRed
                End If

            On Error GoTo 0
        Next
    Next

'********************************************************
'validate the City(Multiples) column in the Questions sheet, such that:
'-   City name matches with one of the Cities or
'-   City name is set as 'All'
'********************************************************

'Dim stString As String
'Dim stArray() As String

'Get the last row
'Dim lastRow As Integer
'LastRow = Sheets("Sheet1").UsedRange.Rows.Count
'nLastRowSheet2 = Sheets("Jurisdictions").UsedRange.Rows.Count

'Dim c As Range
'Dim d As Range
'Dim e As Variant

For Each c In Worksheets("Sheet1").Range("D2:D" & LastRow)
    stString = c
    stArray() = Split(stString, ";")
    For Each e In stArray()
        e = Trim(e)

        'Dim rngFnder As Range
        On Error Resume Next

            Set rngFnder = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).Find(e)

            If rngFnder Is Nothing And c <> "All" Then
                c.Interior.Color = vbRed
            End If

        On Error GoTo 0
    Next
Next

当我尝试将上述所有代码组合成一个代码模块时，我遇到了这个问题。作为 Excel vba 的新手，我不知道如何引用相邻的单元格；如何连接来自三个不同列的字符串（在 'State' 和 'City' 列中，如果有多个条目，我必须首先根据分号将那些 States/Cities 分开）并将它们与三个不同的列进行比较。

谁能帮我写出正确的代码？

Answer 1

根据新信息进行编辑：

我修改了下面的代码以继续遍历 Jurisdiction 范围，直到找到匹配项。如果不是，它将 return 红色。

Dim LastRow As Long
Dim nLastRowSheet2 As Long
Dim rngFnder As Range
Dim strFndAddress As String
Dim stArray() As String
LastRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
nLastRowSheet2 = Sheets("Jurisdictions").Cells(Rows.Count, 2).End(xlUp).Row

For Each c In Worksheets("Sheet1").Range("D2:D" & LastRow)
    stString = c
    stArray() = Split(stString, ";")
    For Each e In stArray()
        e = Trim(e)

        strFndAddress = ""
        On Error Resume Next

            Set rngFnder = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).Find(e)

            If rngFnder Is Nothing And c <> "All" Then
                c.Interior.Color = vbRed

            Else
                Do
                    If c.Offset(, -1) = rngFnder.Offset(, -1) And c.Offset(, -2) = rngFnder.Offset(, -2) Then
                        Exit Do
                    Else
                        strFndAddress = c.Address
                        Set c = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).FindNext(c)

                    End If
                Loop While Not c Is Nothing And c.Address <> strFndAddress
            End If

            If c.Address = strFndAddress Then
                c.Interior.Color = vbRed
            End If
        On Error GoTo 0
    Next
Next

这可以通过按层次结构的相反顺序工作来最容易地处理。如前所述，在 Jurisdictions 工作表中，国家和州都重复，但城市是独一无二的。所以，我们应该先搜索这座城市。一旦找到城市，我们就可以检查城市和州是否匹配。下面是示例代码条目。让我知道它是否有效。

For Each c In Worksheets("Sheet1").Range("D2:D" & LastRow)
    stString = c
    stArray() = Split(stString, ";")
    For Each e In stArray()
        e = Trim(e)

        'Dim rngFnder As Range
        On Error Resume Next

            Set rngFnder = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).Find(e)

            If rngFnder Is Nothing And c <> "All" Then
                c.Interior.Color = vbRed
        Else
        If c.Offset(,-1) = rngFnder.Offset(,-1) AND c.Offset(,-2) = rngFnder.Offset(,-2) then
            'Do Nothing, or enter code if they all match
        Else
            c.Interior.Color = vbRed
        End if
            End If

        On Error GoTo 0
    Next
Next

Offset 方法基于(Rows_to_Move, Columns_to_Move) 从一个范围移动到另一个范围。在代码中，我要求变量 C 检查其左侧的 1 个单元格，并将其与 Jurisdictions 中找到的范围左侧的 1 个单元格进行比较（检查状态），然后我重复 2左边的细胞。如果它们都匹配，则代码什么都不做。否则，单元格突出显示为红色。

请让我知道后续问题。

Answer 2

我又对代码做了修改。我之前的编辑没有按计划进行，因为我混淆了变量名。（作为旁注，这说明了为什么使用易于识别的变量名称很重要。仅调用变量 c 或 e 可能会混淆 reader）。

我还是不完全明白你在 all 条件下需要什么。看看你能否让这部分工作，然后我们可以尝试解决 all 的情况。

Dim LastRow As Long
Dim nLastRowSheet2 As Long
Dim rngFnder As Range
Dim strFndAddress As String
Dim stArray() As String
Dim c As Range
LastRow = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
nLastRowSheet2 = Sheets("Jurisdictions").Cells(Rows.Count, 2).End(xlUp).Row

For Each c In Worksheets("Sheet1").Range("D2:D" & LastRow)
    stString = c
    stArray() = Split(stString, ";")
    For Each e In stArray()
        e = Trim(e)

        strFndAddress = ""
        On Error Resume Next

            Set rngFnder = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).Find(e)

            If rngFnder Is Nothing And c <> "All" Then
                c.Interior.Color = vbRed

            Else
                strFndAddress = rngFnder.Address
                Do
                    If c.Offset(, -1) = rngFnder.Offset(, -1) And c.Offset(, -2) = rngFnder.Offset(, -2) Then
                        strFndAddress = ""
                        Exit Do
                    Else

                        Set rngFnder = Sheets("Jurisdictions").Range("D2:D" & nLastRowSheet2).FindNext(rngFnder)

                    End If
                Loop While Not rngFnder Is Nothing And rngFnder.Address <> strFndAddress
            End If

            If rngFnder.Address = strFndAddress Then
                c.Interior.Color = vbRed
            End If
        On Error GoTo 0
        Set c = Nothing
        strFndAddress = ""
    Next
Next

如何验证 Excel VBA 中三列的层次结构

How to validate Hierarchy of three columns in Excel VBA

excel

vba