VBA用户表单下拉菜单执行



我目前有这段代码,它允许我启动用户表单,在文本框中输入一个项目,自动填充日期,并从下拉菜单中选择然后将该信息粘贴到新行中。

cbm(组合框)项从单独的动态展开表中绘制其值,并且是用户表单上的下拉菜单。日期根据今天的日期自动填充,文本框根据用户输入的任何内容绘制其值。

Private Sub btnSubmit_Click()
Dim ssheet As Worksheet
Set ssheet = ThisWorkbook.Sheets("InputSheet")
nr = ssheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ssheet.Cells(nr, 3) = CDate(Me.tbDate)
ssheet.Cells(nr, 2) = Me.cmblistitem
ssheet.Cells(nr, 1) = Me.tbTicker

这里的目标是,根据选择的列表项,我希望将该项的名称粘贴到与该项对应的列中。例如,如果用户选择"苹果",而第三列是"苹果"列,我希望它粘贴到该位置。

我假设这必须与某种类型的"if"语句有关。

任何帮助都是感激的。这是我的工作表的图片

假设我的猜测是正确的,试试下面的代码

Option Explicit
Private Sub btnSubmit_Click()
    Dim f As Range
    If Me.cmblistitem.ListIndex = -1 Then Exit Sub '<--| exit if no itemlist has been selected
    If Len(Me.tbTicker) = 0 Then Exit Sub '<--| exit if no item has been input
    With ThisWorkbook.Sheets("InputSheet")
        Set f = .Rows(1).Find(what:=Me.cmblistitem.Value, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False) '<--| look for proper column header
        If f Is Nothing Then Exit Sub '<--| if no header found then exit
        With .Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, f.Column) '<--| refer to header column cell corresponding to the first empty one in column "A"
            .Resize(, 3) = Array(Me.tbTicker.Value, Me.cmblistitem.Value, CDate(Me.tbDate)) '<--| write in one shot
        End With
    End With
End Sub

它被注释了,所以你可以很容易地改变列引用根据你的需要

对于组合框填充,您可能需要采用以下代码:
Dim cell As Range
With Me
    For Each cell In [myName]
        .cmblistitem.AddItem cell
    Next cell
End With

在进入循环之前引用了一次Me,因此它在整个循环中都被保留,而不需要进一步的内存访问

最新更新