Question

我正在尝试在excel 2010中进行宏或任何类型的数据验证，以根据另一个单元格的选择等价设置单元格值

例如，假设我有2列像这样填充

A1 ---------- B2

1 ----------我

2 ---------- II

3 ---------- III

4 ---------- IV

5 ---------- V

我想要做的是配置另一列（让我们以D1为例）如果我在任何一行中选择数字“3”，我想要“III”在E1和列中设置在同一行反之亦然，如果我在E1的任何一行中选择IV，我希望D1中的当前行自动设置为“4”

非常感谢任何帮助

Answer 1

将其添加到工作表的代码模块中：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v, nv, f As Range, c As Range, d As Range

    'only considering single-cell updates here...
    Set c = Target.Cells(1)

    'check we're in Col D or Col E
    If Not Intersect(c, Me.Range("D:E")) Is Nothing Then

        v = c.Value     'new value to look up
        nv = ""         'default "matching value" is empty...

        'The cell to be updated: offset to the left or to the right
        '  from the one which was just updated
        Set d = c.Offset(0, IIf(c.Column = 4, 1, -1))
        Set f = Nothing

        If c.Column = 4 Then
            Set f = Me.Range("A1:A10").Find(v, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                nv = f.Offset(0, 1).Value
            End If
        Else 'column=5...
            Set f = Me.Range("B1:B10").Find(v, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                nv = f.Offset(0, -1).Value
            End If
        End If

        'Turn off events to prevent re-triggering this method
        Application.EnableEvents = False

        'update the other cell....
        d.Value = nv  

        'Re-enable events: must do this! 
        Application.EnableEvents = True

    End If
End Sub

编辑：这是一个更通用的方法，可以覆盖任意数量的列

Private Sub Worksheet_Change(ByVal Target As Range)

    Const LOOKUP_RANGE As String = "A1:C5" 'Lookup table
    Const INPUT_RANGE As String = "D:F"    'Where you want to respond to input
                                           ' should be same # of cols as lookup range

    Dim v, c As Range, d As Range, rw As Range, colNum As Long, m

    Set c = Target.Cells(1) 'only considering single-cell updates here...

    'check we're in the "input" range
    If Not Intersect(c, Me.Range(INPUT_RANGE)) Is Nothing Then

        'This is the range to be updated
        Set rw = Application.Intersect(c.EntireRow, Me.Range(INPUT_RANGE))
        'which column to check?
        colNum = (c.Column - rw.Cells(1).Column) + 1

        v = c.Value     'new value to look up

        'see if we can find the just-entered value in the lookup range
        m = Application.Match(v, Me.Range(LOOKUP_RANGE).Columns(colNum), 0)

        'Turn off events to prevent re-triggering this method
        Application.EnableEvents = False

        If Not IsError(m) Then
            rw.Value = Me.Range(LOOKUP_RANGE).Rows(m).Value
        Else
            rw.ClearContents 'no match: clear the row
            c.Value = v 'and restore the entered value
        End If

        'Re-enable events: must do this!
        Application.EnableEvents = True

    End If
End Sub

Excel 2010宏来获取和设置另一个单元格中的等价

1 个答案: