Question

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

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

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

我的目标是，根据选择的列表项，我希望将该项的名称粘贴到与该项对应的列中。即如果用户选择＆＃34; apples＆＃34;第三列是＆＃34; apple＆＃34;列，我希望它粘贴在该位置。

我假设必须使用某种类型的＆＃34;如果＆＃34;声明。

感谢任何帮助。 Here is pic of my worksheet

Answer 1

假设我正确地进行了猜测，请尝试使用此代码

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

它已被评论，因此您可以根据需要轻松更改列引用

BTW对于组合框填充，您可能需要采用以下代码：

Dim cell As Range
With Me
    For Each cell In [myName]
        .cmblistitem.AddItem cell
    Next cell
End With

在进入循环之前已经引用Me一次进行了优化，以便在没有进一步内存访问的情况下将其保留在整个循环中

VBA Userform下拉菜单执行

1 个答案: