使用由数据验证列表确定的Vlookup填充单元格

时间：2019-05-13 19:00:45

标签： excel vba

我有一个电子表格，希望基于数据验证下拉列表自动填充单元格；该列表在A2：A100，CR或DR中有2个选择。我要填充单元格的文本是工作簿中另一张纸上的Vlookup。如果用户选择CR或Dr，它将使用vlookup代码填充某些单元格，这些代码将根据用户输入B2：B100的数字来更新状态。

我尝试了一些不同的代码，但结果却保持不变。几次尝试都可以正常工作，但由于某种原因最终会损坏。我最终遇到的问题是，如果我有多个填充B2：B100的数字，并且具有所有不同的选择（CR或DR），那么最终它们都将在A1：A100或D2中的单元格切换到相同的CR / DR状态： H100全部用'＃N / A'填充，我无法让他们根据vlookup更新单元格。

示例Here

我尝试使用宏，并让vba根据选择而不是宏来填充单元格，但两者都不起作用，我最终只是在这里做了我的工作，并且得到了相同的结果。 / p>

我在一个论坛上找到了代码，并且工作了一段时间，但是当我清除所有单元格中都填满“＃N / A”的内容时，它就崩溃了。

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
    Dim C As Long
    Dim K As Long
    Dim R As Long
    Dim S As Long
    Dim E As Long
    Dim I As Long
    Dim T As Long


    If Not Application.Intersect(Target, Range("A2:A70")) Is Nothing Then
        SetApplication False
        With Target
            If StrComp(Trim(.Value), "CR", vbTextCompare) = 0 Then

                'For C = Columns("B").Column To Columns("B").Column
                 '   Cells(.Row, C).Value = "CR"
                'Next C
                'For K = Columns("C").Column To Columns("C").Column
                '    Cells(.Row, K).Value = "=VLOOKUP(RC[-1],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,2,FALSE)"
                'Next K
                For R = Columns("D").Column To Columns("D").Column
                    Cells(.Row, R).Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,2,FALSE)"
                Next R
                For S = Columns("E").Column To Columns("E").Column
                    Cells(.Row, S).Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,7,FALSE)"
                Next S
                'For E = Columns("F").Column To Columns("F").Column
                '    Cells(.Row, E).Value = "=VLOOKUP(RC[-4],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"
                'Next E
                For I = Columns("G").Column To Columns("G").Column
                    Cells(.Row, I).Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,9,FALSE)"
                Next I
                For T = Columns("H").Column To Columns("H").Column
                    Cells(.Row, T).Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,3,FALSE)"
                Next T

            ElseIf StrComp(Trim(.Value), "DR", vbTextCompare) = 0 Then

                For K = Columns("C").Column To Columns("C").Column
                    Cells(.Row, K).Value = "=VLOOKUP(RC[-1],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,2,FALSE)"
                Next K
                For R = Columns("D").Column To Columns("D").Column
                    Cells(.Row, R).Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,3,FALSE)"
                Next R
                For S = Columns("E").Column To Columns("E").Column
                    Cells(.Row, S).Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,4,FALSE)"
                Next S
                For E = Columns("F").Column To Columns("F").Column
                    Cells(.Row, E).Value = "=VLOOKUP(RC[-4],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"
                Next E
                For I = Columns("G").Column To Columns("G").Column
                    Cells(.Row, I).Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,6,FALSE)"
                Next I
                For T = Columns("H").Column To Columns("H").Column
                    Cells(.Row, T).Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,7,FALSE)"
                Next T
            End If
        End With
        SetApplication True
    End If

End Sub

Private Sub SetApplication(ByVal AppMode As Boolean)

    With Application
        .EnableEvents = AppMode
        .ScreenUpdating = AppMode
    End With
End Sub

这是我尝试使用宏时使用的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Not Intersect(Target, Range("A2:A99")) Is Nothing Then
    Select Case Target.Value
        Case "CR": CR
        Case "DR": DR
    End Select
End If
End Sub

Sub CR()
Dim ThisRow As Long
ThisRow = ActiveCell.Row
Cells(ThisRow, "F").ClearContents
Cells(ThisRow, "G").ClearContents
Cells(ThisRow, "H").ClearContents
Cells(ThisRow, "D").Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,2,FALSE)"
Cells(ThisRow, "E").Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,7,FALSE)"
Cells(ThisRow, "G").Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,9,FALSE)"
Cells(ThisRow, "H").Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,3,FALSE)"

End Sub


Sub DR()
Dim ThisRow As Long
ThisRow = ActiveCell.Row
Cells(ThisRow, "C").ClearContents
Cells(ThisRow, "D").ClearContents
Cells(ThisRow, "E").ClearContents
Cells(ThisRow, "F").ClearContents
Cells(ThisRow, "G").ClearContents
Cells(ThisRow, "H").ClearContents
Cells(ThisRow, "C").Value = "=VLOOKUP(RC[-1],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,2,FALSE)"
Cells(ThisRow, "D").Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,3,FALSE)"
Cells(ThisRow, "E").Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,4,FALSE)"
Cells(ThisRow, "F").Value = "=VLOOKUP(RC[-4],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"
Cells(ThisRow, "G").Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,6,FALSE)"
Cells(ThisRow, "H").Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,7,FALSE)"

End Sub

2 个答案:

答案 0 :(得分：0)

制作2张纸。一种称为“ CR”，一种称为“ DR”。现在，用户将从下拉菜单中选择所需的视图，而不是从下拉列表中进行选择。这些工作表将包含您需要的所有VLOOKUPS。您可以使用IF来处理空格，因为您说自己可能有可变数量的数据行。

例如：

=IF(A1 = "", "", "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,2,FALSE)")

仅当A1包含一个值时，它才会显示VLOOKUP。更改该值以匹配您需要进行的任何检查，以确保该行上有数据。

答案 1 :(得分：0)

我相信我真的知道了。我使用了这段代码：

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo CleanExit:

    If Not Intersect(Target, Range("A:A")) Is Nothing Then

        Application.EnableEvents = False

        If Target.Value = "CR" Then
            'Target.Offset(0, 1).Value = "Overdue1"
            Target.Offset(0, 2).Value = "'"
            Target.Offset(0, 3).Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,2,FALSE)"
            Target.Offset(0, 4).Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,7,FALSE)"
            Target.Offset(0, 5).Value = "'"
            Target.Offset(0, 6).Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C2:R1048576C10,9,FALSE)"
            Target.Offset(0, 7).Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C2:R1048576C8,3,FALSE)"
        ElseIf Target.Value = "DR" Then
            'Target.Offset(0, 1).Value = "Over1"
            Target.Offset(0, 2).Value = "=VLOOKUP(RC[-1],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,2,FALSE)"
            Target.Offset(0, 3).Value = "=VLOOKUP(RC[-2],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,3,FALSE)"
            Target.Offset(0, 4).Value = "=VLOOKUP(RC[-3],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,4,FALSE)"
            Target.Offset(0, 5).Value = "=VLOOKUP(RC[-4],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"
            Target.Offset(0, 6).Value = "=VLOOKUP(RC[-5],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"
            Target.Offset(0, 7).Value = "=VLOOKUP(RC[-6],'IBM Rational ClearQuest Web'!R2C12:R1048576C18,5,FALSE)"

        End If

        Application.EnableEvents = True

    End If

    Exit Sub

CleanExit:
        Application.EnableEvents = True
        Err.Clear


End Sub

我还认为，我为数据创建的表也导致excel行为异常。当我将数据格式化为表格时，该表格中的所有行/列都会随着宏的运行而更新。但是，当他们不在桌子上时，它们的运行就很好。我不知道为什么，但是我最终没有将任何内容格式化为表格。

相关问题
最新问题