Vba 在工作表中使用列表选项并过滤条件

我有两张表，Sheet1是数据库表，sheet2是输入表

对于A列的数据库表，我有ID

对于输入表，我有ID为的B列。我在每个单元格和每列中创建了一个下拉列表。我通过数据验证填充了列表

我想知道，如果可能的话，我可以在输入表的B列中选择一个ID。并在行中显示相应的结果。例如：如果我正在填写B列，那么根据B列ID，A、C、D、E列应该自动填写

两张图纸中的立柱布置不相同。但标题名称是相同的

谁能帮助解决这个关键问题。先谢谢你

编辑：

Sub DEMO()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = Sheets("DataBase")
Set destWS = ThisWorkbook.Sheets("Input")
srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.Count, "B").End(xlUp).Row
For i = 2 To destLastRow
For j = 5 To srcLastRow
If destWS.Cells(i, "B").Value = srcWS.Cells(j, "A").Value Then
destWS.Cells(i, "A") = srcWS.Cells(j, "B")
destWS.Cells(i, "C") = srcWS.Cells(j, "C")
destWS.Cells(i, "D") = srcWS.Cells(j, "D")
destWS.Cells(i, "E") = srcWS.Cells(j, "E")
destWS.Cells(i, "F") = srcWS.Cells(j, "f")
destWS.Cells(i, "G") = srcWS.Cells(j, "G")
destWS.Cells(i, "H") = srcWS.Cells(j, "H")
destWS.Cells(i, "I") = srcWS.Cells(j, "I")
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

我有这个代码。但我想把它换成零钱。当我尝试对工作表进行同样的更改时，它给出了一个stackoverflow错误。 excel停止响应

编辑：

---

这是经过重构的代码，以适应工作表更改事件。此代码将进入输入工作表的代码中

Private Sub Worksheet_Change(ByVal Target As Range)
Dim srcRow As Long
Dim chgRng As Range
Dim rng As Range
Dim srcWS As Worksheet

Set srcWS = Sheets("DataBase")

Set chgRng = Intersect(Me.Range("B:B"), Target)
If Not chgRng Is Nothing Then
    Application.ScreenUpdating = False
    For Each rng In chgRng
        srcRow = 0
        On Error Resume Next
            srcRow = Application.WorksheetFunction.Match(rng, srcWS.Range("A:A"), 0)
        On Error GoTo 0

        If srcRow > 0 Then
            On Error GoTo GetOut
            Application.EnableEvents = False
            Me.Cells(rng.Row, "A").Value = srcWS.Cells(srcRow, "B").Value
            Me.Range(Me.Cells(rng.Row, "C"), Me.Cells(rng.Row, "I")).Value = srcWS.Range(srcWS.Cells(srcRow, "C"), srcWS.Cells(srcRow, "I")).Value
            Application.EnableEvents = True
            On Error GoTo 0
        End If
    Next rng
End If

GetOut:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

试试这个代码

Sub DEMO()
Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long, k As Integer, n As Long
Dim vDB, rngDB As Range, vData

Application.ScreenUpdating = False
Set srcWS = Sheets("DataBase")
Set destWS = ThisWorkbook.Sheets("Input")

srcLastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.Count, "B").End(xlUp).Row

vData = srcWS.Range("a5").CurrentRegion

With destWS
    Set rngDB = .Range("a2", "h" & destLastRow)
    vDB = rngDB
End With
n = UBound(vDB, 1)
For i = 1 To n
    For j = 2 To UBound(vData, 2)
        If vDB(i, 2) = vData(j, 1) Then
            vDB(i, 1) = vData(j, 2)
            For k = 3 To 8
                vDB(i, k) = vData(j, k)
            Next k
            Exit For
        End If
    Next j
Next i
rngDB = vDB
Application.ScreenUpdating = True
End Sub

---

@ScottCraner现在就要关闭了吗？@ScottCraner我找不到任何与我的问题相关的东西，这就是为什么我有这个没有代码的空白帖子。对此我很抱歉。但是我没有继续下去的想法，这就是为什么我在报告中问的原因forum@Jenny你的数据库有多大。您可以使用工作表\u change event来执行此操作，但当数据较多时，此操作可能会变慢。您收到的错误是因为每次更改都会导致再次调用事件，并创建一个将使Excel崩溃的循环。我没有得到结果。我的床单没什么问题