使用vba在excel中设置外键约束

Question

说我有以下电子表格：

A      B            C      D       E     F     G        H        I
----------------------------------------------------------------------------
code   dataElem     age   sex    place   type  value    denom    denom_code
----------------------------------------------------------------------------
a1     population   all   all    all     num   10       1        1
a2     population   all   all    rural   num   6        1        1
a3     population   all   all    urban   num   4        1        1
a4     wealthy      all   all    all     %     40       10       a1
a5     wealthy      all   all    all     %     34       6        a2
a6     wealthy      all   all    all     %     50       4        a3
a7     Educated     all   all    all     %     70       10       a1
a8     Educated     all   all    all     %     50       6        a2
a9     Educated     all   all    all     %     100      4        a3
...

具有如上给出的值，以及A列和A列中的单元格A2-A4（即a1，a2和a3）的位置。列G中的单元G2-G4（10,6和4）是主键。我想强制执行后续字段使用上面定义的主键作为外键。也就是说，必须根据外键单元格检查输入的新记录，外键单元格是列H（denom）和列I（denom_code）。为了进一步说明，每当我选择输入新记录时说第5行（a4，富裕，全部，全部，全部，％，40,10，a1），代码检查以确保H5和I5都对应于A2 = a1和G2 = 10。对于row6（a5，富裕，全部，全部，全部，％，34,6，a2），H6和I6都对应于A3 = a2和G3 = 6。 如何在excel vba中实现此功能。

Sub sbHighlightDuplicatesInColumn()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long

    lastRow = Sheets("Sheet1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For iCntr = 1 To lastRow
        If Cells(iCntr, 1) <> "" Then
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range(Cells(1, 1), Cells(iCntr, 1)), 0)
            If iCntr <> matchFoundIndex Then
                Sheets("Sheet1").Cells(iCntr, 1).Interior.Color = vbYellow
            End If
        End If
    Next

    'iterating over the 2 columns...

    numOfRows = ActiveWorkbook.Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Range("A2").End(xlDown)).Rows.Count
    freq = numOfRows / 12

    Dim lastRowL As Long
    lastRowL = Sheets("Sheet1").Range("L1").SpecialCells(xlCellTypeLastCell).Row

    Dim LastRowM As Long
    LastRowM = Sheets("Sheet1").Range("M1").SpecialCells(xlCellTypeLastCell).Row

    Dim rg1 As Range, rg2 As Range
    Set rg1 = ActiveWorkbook.Worksheets("Sheet1").Range("A2:A4")
    Set rg2 = ActiveWorkbook.Worksheets("Sheet1").Range("G2:G4")

    ' Create dynamic array
    Dim tmpArray1 As Variant, tempArray2 As Variant
    Dim code As Variant, value As Variant

    'Dump the range into a 2D array
    tmpArray1 = rg1.value
    tmpArray2 = rg2.value

    'Resize the 1D array
    ReDim code(1 To UBound(tmpArray1, 1))
    ReDim value(1 To UBound(tmpArray2, 1))

    'Convert 2D to 1D
    For i = 1 To UBound(code, 1)
        code(i) = tmpArray1(i, 1)
        value(i) = tmpArray2(i, 1)
    Next

    For cnt = 1 To freq
        'iterate over col-L
        Dim u As Integer, v As Integer
        u = cnt * 3 + 2
        v = u + 2

        Dim iTrack As Integer
        iTrack = 1
        'iterate over col-L
        For iCntr = u To v
            If Cells(iCntr, 8) <> "" Then
                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 8), Range(Cells(1, 8), Cells(iCntr, 8)), 0)
                If code(iTrack) <> matchFoundIndex Then
                    Sheets("Sheet1").Cells(iCntr, 8).Interior.Color = vbYellow
                Else
                    Sheets("Sheet1").Cells(iCntr, 8).Interior.Color = vbGreen
                End If
            End If
            iTrack = iTrack + 1
        Next

        iTrack = 1
        'iterate over col-M
        For iCntr = u To v
            If Cells(iCntr, 9) <> "" Then
                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 9), Range(Cells(1, 9), Cells(iCntr, 9)), 0)
                If value(iTrack) <> matchFoundIndex Then
                    Sheets("Sheet1").Cells(iCntr, 9).Interior.Color = vbRed
                Else
                    Sheets("Sheet1").Cells(iCntr, 9).Interior.Color = vbGreen
                End If
            End If
            iTrack = iTrack + 1
        Next
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim curColor As Variant
    curColor = ActiveCell.Interior.Color
    If Application.CountIf(Range("A:A"), Target) > 1 Then
        MsgBox "Duplicate Data", vbCritical, "Remove Data"
        Target.value = ""
        'ActiveCell.Offset(RowOffset:=-1).EntireRow.Interior.Color = curColor
    End If
End Sub