Question

我正在为多个用户开发简单的Excel应用程序，这些用户将在流程的不同阶段输入数据。不幸的是，我遇到了在表格的一行中存储来自多个用户表单的数据的问题。

我会尽可能清楚地解释整件事情是什么。

出于示例目的，我将应用程序称为“电影时间控制”。让我们想象一下，它是一个控制观看电影的工具，重点是：

电影开始时，
如果在展示期间有一些休息（以及为什么）
当电影重新启动时（休息时间有多长，以及有多少休息以及采取了哪些措施继续），
如果电影中止，何时以及为什么？
电影结束时。

应用程序段的菜单将如下面的屏幕截图所示：

对于每个按钮，分配不同的用户形式。在每个表单中输入的数据应存储在特定表单中的一行中。

用户表单的功能：

电影开始：在表格中创建包含电影标题，日期和时间的条目。
MOVIE BREAK：根据之前定义的电影标题，填写日期和时间，休息原因（如果不是标准，则从下拉列表或文本框中填写）。该功能最多可使用三次（三次休息）。
MOVIE RESTART：如果发生中断，请填写有关日期，电影重新开始的时间以及为处理之前定义的中断原因而采取的操作的信息。对于每个中断（可能三个），可以使用函数。
MOVIE ABORT当（日期和时间）电影中止时（无意继续）。
电影结束时（日期和时间）电影结束。

问题出现的地方（问题）：

输入第一行的数据后，将在表格单独表格中创建具有特定标题的条目。基于此条目，所有其他用户表单中的Title Combobox应列出已启动但未完成或中止的标题 - 只需快速选择“打开标题”并填写与标题相关的其他信息。 如何创建宏以列出组合框中的“打开案例”？
在创建具有特定电影标题的条目后，我无法找到如何将其余数据传输到表格的同一行，但是所有表格中的列都不同。重要的是，数据只能添加到具有相应标题的行中（从第一个问题的组合框中选择）。 你可以帮助我使用宏吗？

宏我创建到现在（我是VBA的初学者，感谢您的理解）：

MOVIE START：用于创建带有电影标题的条目。

Private Sub movie_start_save_Click()

If MsgBox("ARE YOU SURE?", vbYesNo, "Please confirm") = vbYes Then

Dim emptyRow As Long

'Make Sheet2 active
Sheet2.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 1).Value = Movie_Title_Box.Value
Cells(emptyRow, 2).Value = Start_Date_Box.Value
Cells(emptyRow, 3).Value = Start_Time_Box.Value
'Closing the form
Unload Me
'Back to MENU
Sheet1.Select
End If
End Sub


Private Sub movie_start_cancel_Click()

Unload Me

End Sub

MOVIE BREAK：用于定义时间和原因（无法传输数据）：

Private Sub UserForm_Initialize()

'Fill ReasonComboBox
With ReasonComboBox
    .AddItem "Tea"
    .AddItem "Coffee"
    .AddItem "Popcorn"
    .AddItem "Dinner"
    .AddItem "Not standard"
End With

'Default text in the reason box
ReasonTextBox.ForeColor = &HC0C0C0 '<~~ Grey Color
    ReasonTextBox.Text = "In case of 'not standard' reason leave your comment here"
    movie_break_cancel.SetFocus '<~~ This is required so that the focus moves from TB

End Sub
'Default text in the reason box - disapearing when you want to edit
Private Sub ReasonTextBox_Enter()
    With ReasonTextBox
        If .Text = "In case of 'not standard' reason leave your comment here" Then
            .ForeColor = &H80000008 '<~ Black Color
            .Text = ""
        End If
    End With
End Sub
'Default text in the reason box - somehow disappearing for good, but ok
Private Sub ReasonTextBox_AfterUpdate()
    With ReasonTextBox
        If .Text = "" Then
            .ForeColor = &H80000008
            .Text = ""
        End If
    End With
End Sub

'Cancel Button
Private Sub movie_break_cancel_Click()

Unload Me

End Sub

其余部分实际上与一些差异类似。

下载excel文件的链接：

https://drive.google.com/file/d/0BxFSL2h-9qflQjRzNTQ2ZlhJNjA/view?usp=sharing

希望我表达自己清楚明白这一点。问候！

Answer 1

在下面的示例中，我将展示如何配置ComboBox以保存多列数据并稍后检索值。这将允许您将行号与电影数据一起存储在ComboBox中。

＆＃39;过滤未完成的组合框工作 Private Sub UserForm_Initialize（） Dim ws As Worksheet Dim x As Long

    With Me.Movie_Title_ComboBox
        .ColumnCount = 4
        .ColumnWidths = "0 pt;250 pt;90 pt; 90 pt;"
        '.ListWidth = 500
        .TextColumn = 2
        .BoundColumn = 1
    End With

    Set ws = Sheet2
    With ws
        For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            If .Cells(x, 4).Value = "" Then
                AddItems Me.Movie_Title_ComboBox, x, .Cells(x, 1).Value, Format(.Cells(x, 3).Value, "MM/DD/YYYY"), Format(.Cells(x, 3).Value, "HH:MM")
            End If
        Next
    End With
End Sub

Private Sub Movie_Title_ComboBox_Change()
    With Me.Movie_Title_ComboBox
        If .ListIndex > -1 Then
            Finish_Date_Box.Value = .List(.ListIndex, 2)
        End If
    End With
End Sub

Private Sub movie_finished_save_Click()
    With Sheet2
        .Cells(Me.Movie_Title_ComboBox.Value, 4) = Me.Finish_Date_Box.Value
        .Cells(Me.Movie_Title_ComboBox.Value, 5) = Me.Start_Time_Box.Value
    End With
End Sub

将此功能添加到公共代码模块，以便所有用户表单都可以使用。

Sub AddItems(oComboBox As MSForms.ComboBox, ParamArray Items() As Variant)
    Dim x As Long

    With oComboBox
        .AddItem Items(0)
        For x = 1 To UBound(Items)
            .List(.ListCount - 1, x) = Items(x)
        Next
    End With

End Sub

Excel 2013 VBA多个用户表单填写表

1 个答案: