Excel快速录入工具：

 Excel快速录入工具：

效果图：

效果图

插入一个ListBox:

调整成自己喜欢的风格

           

代码存放在Sht1里：

Sht3里插入几个表，

改好表头和表名，这就是弹出列表框的数据源，还可以插入新的表，表头和表名保持一致

Dim Rngs As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Target
        Dim iHeaderStr As String, iOk  As Boolean
        Dim Rng As Range, iArr(), ObjLst As ListObject
        iHeaderStr = Cells(1, Target.Column).Value
        For Each ObjLst In Sht3.ListObjects
            If ObjLst.Name = iHeaderStr Then iOk = True
        Next ObjLst
        
        If iOk Then
            Set Rng = Sht3.Range(Replace("{0}[{0}]", "{0}", iHeaderStr))
            With ListBox1
                For i = 0 To .ListCount
                    .Selected(i) = False
                Next i
            End With
            
            iArr = Rng
            ListBox1.List = iArr
            ListBox1.Left = Target.Left + .Width + 25
            ListBox1.Top = .Top
            ListBox1.Width = Target(1).Width + 23
            ListBox1.Height = 220

            If Not ListBox1.Visible Then
                ListBox1.Visible = True
            End If

            Set Rngs = Target
        Else
            ListBox1.Visible = False
            Exit Sub
        End If
    End With
End Sub

Private Sub ListBox1_Change()
    Dim i As Long

    With ListBox1
        For i = 0 To .ListCount
            If .Selected(i) = True Then
                Rngs.Value = .List(i, 0)
            End If
        Next
    End With
End Sub