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

时间：2015-01-22 11:15:26

标签： excel-vba vba excel

我有一个出色的表现;有两张纸：

第一张表是：＆＃39; Jurisdictions＆＃39; 其中有三列：

国家（B栏），州（C栏）和城市（D栏）

此表单为每个城市提供单一条目。

但是，由于每个城市都列在不同的行上，州和国家的名称（城市所属的名称）可以在多行上重复。

对于Ex：

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

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

（这是我的两行）

我有另一张纸：Sheet1;

这里我也有三个相同的栏目; （还有20个其他专栏）

这三栏我将在“管辖区”的三栏中进行验证。片。 （Sheet1中只列出了少数“司法管辖区”;这些可以是任何顺序，可以是任何国家/地区）

验证规则是：

1）对于国家

- 国家/地区名称应仅为单个值。

- 应与＆＃39;国家＆＃39;下的姓名匹配管辖权表中的一栏。

- 应忽略案例（大写/小写）

2）状态

- 可以只用分号分隔一个或多个值（用分号分隔这些值我写了不同的代码，它工作正常）

- 此单元格中的条目甚至可以是“全部”

- 所有州名称应与州＆＃39;州＆＃39;下列出的州相匹配。管辖表栏目。 （如果列出了多个条目;应首先根据分隔符分隔 - 分号然后进行比较）

- 应忽略案件（大写/小写）;应修剪州名之前和之后的额外空格。

3）城市

- 可以只用分号

分隔一个或多个值

- 此单元格中的条目可以是全部＆＃39;还

- 所有城市名称都应与“城市”中列出的城市相匹配。管辖表栏目。 （如果列出了多个条目;应首先根据分隔符分隔 - 分号然后进行比较）

- 应忽略案件（大写/小写）;应修剪州名之前和之后的额外空格。

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

但这还不够...... !!!

我也要验证层次结构.. !!

即。 

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的新手，我不知道如何引用相邻的细胞;如何连接字符串（在＆＃39;州＆＃39;城市＆＃39;列，我必须首先根据分号，如果有多个条目，将这些州/城市分开）来自三个不同的列，并将它们与三个不同的栏目。

有人可以帮我写出正确的代码吗？

2 个答案:

答案 0 :(得分：1)

我已经对代码做了另一项修改。我之前的编辑没有按计划工作，因为我混淆了变量名称。 （作为旁注，这说明了为什么使用易于识别的变量名称非常重要。只需调用变量c或e就可能使读者感到困惑。

我仍然无法完全理解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

答案 1 :(得分：0)

基于新信息的编辑：

我修改了下面的代码，继续迭代管辖范围，直到找到匹配为止。如果没有，它将返回红色。

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细胞向左。如果它们都匹配，则代码不执行任何操作。否则，单元格将突出显示为红色。

请让我知道后续问题。

相关问题
最新问题