Question

有人可以帮我解决问题吗？新要求是组合框由一个列表框替换，该列表框将允许多个选择并输入到单个单元格中。我所说的那个是Me.Reason_RRT_Called任何帮助都会受到极大的关注。代码如下。

            Option Explicit
Dim WrkSheet As Worksheet

Private Sub CommandButton1_Click()
    Application.EnableEvents = False

    Dim ssheet As Workbook
    Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String
    Dim cellVal5 As String, cellVal6 As String, cellVal7 As String, cellVal8 As String
    Dim cellVal9 As String, cellVal10 As String, cellVal11 As String, cellVal12 As String
    Dim cellVal13 As String, cellVal14 As String

    Dim shtCmb As String
    Dim RwLast As Long
    Dim Reasons As String
    Dim n As Integer

    shtCmb = Me.Year.Value
        If shtCmb = "" Then
             MsgBox "Please choose a Year.", vbOKOnly
             Me.Year.SetFocus
    End If
         For n = 0 To Reason_RRT_Called.ListCount - 1
             If Reason_RRT_Called.Selected(n) = True Then
                Reasons = Reasons & Reason_RRT_Called.List(n) & "; "
             End If
         Next n

    cellVal1 = Me.Year.Text
    cellVal2 = Reasons
    cellVal3 = Me.Type_Of_Recomendations.Text
    cellVal4 = Me.Documentation_On_Templates.Text
    cellVal5 = Me.MD_Notified.Text
    cellVal6 = Me.Location.Text
    cellVal7 = Me.Code_Rapid_Response.Text
    cellVal8 = Me.Report_Sent_To_QM.Text
    cellVal9 = Me.Vital_Signs_Documneted.Text
    cellVal10 = Me.Assessments_Completed.Text
    cellVal11 = Me.Response_Time.Text
    cellVal12 = Me.Date_Of_Incedent.Text
    cellVal13 = Me.Patients_Name.Text
    cellVal14 = Me.Unit_Location.Text

    RwLast = Worksheets(shtCmb).Range("B" & Worksheets(shtCmb).Rows.Count).End(xlUp).Row

    Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal1
    Worksheets(shtCmb).Range("H" & RwLast + 1).Value = cellVal2
    Worksheets(shtCmb).Range("K" & RwLast + 1).Value = cellVal3
    Worksheets(shtCmb).Range("L" & RwLast + 1).Value = cellVal4
    Worksheets(shtCmb).Range("N" & RwLast + 1).Value = cellVal5
    Worksheets(shtCmb).Range("E" & RwLast + 1).Value = cellVal6
    Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
    Worksheets(shtCmb).Range("G" & RwLast + 1).Value = cellVal8
    Worksheets(shtCmb).Range("I" & RwLast + 1).Value = cellVal9
    Worksheets(shtCmb).Range("J" & RwLast + 1).Value = cellVal10
    Worksheets(shtCmb).Range("M" & RwLast + 1).Value = cellVal11
    Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal12
    Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal13
    Worksheets(shtCmb).Range("F" & RwLast + 1).Value = cellVal14

    Application.EnableEvents = True

End Sub
Private Sub optionCancel_Click()
    Unload Me
End Sub


Private Sub UserForm_Initialize()

    Dim SH As Worksheet
    Dim Entry As Variant

    'Auto date fill text box
    'Date_Of_Incedent.Value = Format(Date, "mm/dd/yyyy")

      'Year(Year(Now)) - Will return the name of the current Year
    For Each SH In ThisWorkbook.Worksheets
        If SH.Name = Year Then
            Set WrkSheet = SH
            Exit For
        End If
    Next

    'fill the combo box
    With Me.Year
        For Each Entry In [List1]
            .AddItem Entry
        Next Entry
        .Value = Year
    End With

    'fill the listBox
    With Me.Reason_RRT_Called
        For Each Entry In [List2]
          .AddItem Entry
        Next Entry
    End With


       'fill the combo box
    With Me.Type_Of_Recomendations
        For Each Entry In [List3]
            .AddItem Entry
        Next Entry
    End With

           'fill the combo box
    With Me.Documentation_On_Templates
        For Each Entry In [List4]
            .AddItem Entry
        Next Entry
    End With

              'fill the combo box
    With Me.MD_Notified
        For Each Entry In [List5]
            .AddItem Entry
        Next Entry
    End With

        'fill the combo box
    With Me.Location
        For Each Entry In [List6]
            .AddItem Entry
        Next Entry
    End With

    'fill the combo box
    With Me.Code_Rapid_Response
        For Each Entry In [List7]
            .AddItem Entry
        Next Entry
    End With

    'fill the combo box
    With Me.Report_Sent_To_QM
        For Each Entry In [List8]
            .AddItem Entry
        Next Entry
    End With

    'fill the combo box
    With Me.Vital_Signs_Documneted
        For Each Entry In [List9]
            .AddItem Entry
        Next Entry
    End With

 'fill the combo box
    With Me.Assessments_Completed
        For Each Entry In [List10]
            .AddItem Entry
        Next Entry
    End With

  'fill the combo box
    With Me.Response_Time
        For Each Entry In [List11]
            .AddItem Entry
        Next Entry
    End With

End Sub

Answer 1

要为单元格创建下拉列表，我使用数据验证。要使用VBA创建下拉列表，请使用以下代码行：

With range("A1").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=B1:B6"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

而不是“A1”将您想要的单元格放在下拉列表中。而不是“= B1：B6”放置范围来获取数据。

用于多个输入到单个单元格的列表框用户表单

1 个答案: