vba 组合框用户表单基于列表选择到其他工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19521957/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
comboboxes userforms Based on list selection to other worksheets
提问by Gary Carroll
Based on the selection made in a combo box on a userform how do I send the selection made to a desired worksheet. For example, we have 12 worksheets in a work book. Each worksheets name is a name of a month in the year. The combo box selection is all the months of the year. January - December. I f I select January in the combo box I want all the other entries on the userform to go to January worksheet. If I select February I want all the entries in the other text boxes to go to February worksheet and so on. How do I accomplish this?? Any help will be greatly appriciated!!!
基于在用户窗体上的组合框中所做的选择，我如何将所做的选择发送到所需的工作表。例如，我们在一本工作簿中有 12 个工作表。每个工作表名称都是一年中的一个月的名称。组合框选择是一年中的所有月份。一月-十二月。如果我在组合框中选择了一月，我希望用户表单上的所有其他条目都转到一月工作表。如果我选择二月，我希望其他文本框中的所有条目都转到二月工作表，依此类推。我如何实现这个？？任何帮助将不胜感激！！！
I re-edited the code. Only problem now is the cellVal4 = Me.tbDate.Text The error lies with the .Text highlighted. Also when I submit the form it does not add a new row for each entry it changes the same row the first entry was on.
我重新编辑了代码。现在唯一的问题是 cellVal4 = Me.tbDate.Text 错误在于 .Text 突出显示。此外，当我提交表单时，它不会为每个条目添加新行，而是更改了第一个条目所在的同一行。
Option Explicit
Dim WrkSheet As Worksheet
Dim WrkSheet 作为工作表
Private Sub btnSubmit_Click() Application.EnableEvents = False
私有子 btnSubmit_Click() Application.EnableEvents = False
Dim ssheet As Workbook Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String, cellVal6 As String, cellVal7 As String, cellVal8 As String, cellVal9 As String, cellVal10 As String, cellVal11 As String, cellVal12 As String Dim cellVal13 As String, cellVal14 As String, cellVal15 As String, cellVal16 As String, cellVal17 As String, cellVal18 As String, cellVal19 As String, cellVal20 As String, cellVal21 As String, cellVal22 As String Dim cellVal23 As String, cellVal24 As String, cellVal25 As String, cellVal26 As String, cellVal27 As String, cellVal28 As String, cellVal29 As String, cellVal30 As String, cellVal31 As String, cellVal32 As String, cellVal33 As String, cellVal34 As String
Dim ssheet As Workbook Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String, cellVal6 As String, cellVal7 As String, cellVal8 As String, cellVal9 As String, cellVal10 As String, cellVal11 As String, cellVal12 As String Dim cellVal13 As String, cellVal14 As String, cellVal15 As String, cellVal16 As String, cellVal17 As String, cellVal18 As String, cellVal19 As String, cellVal20 As String, cellVal21 As String, cellVal22 As String Dim cellVal23 As String, cellVal24 , cellVal25 As String, cellVal26 As String, cellVal27 As String, cellVal28 As String, cellVal29 As String, cellVal30 As String, cellVal31 As String, cellVal32 As String, cellVal33 As String, cellVal34 As String
Dim shtCmb As String
Dim RwLast As Long
shtCmb = Me.cmbListItem1.Value
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.TextBox31.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text
cellVal8 = Me.TextBox4.Text
cellVal9 = Me.TextBox5.Text
cellVal10 = Me.TextBox6.Text
cellVal11 = Me.TextBox7.Text
cellVal12 = Me.TextBox8.Text
cellVal13 = Me.TextBox9.Text
cellVal14 = Me.TextBox10.Text
cellVal15 = Me.TextBox11.Text
cellVal16 = Me.TextBox12.Text
cellVal17 = Me.TextBox13.Text
cellVal18 = Me.TextBox14.Text
cellVal19 = Me.TextBox15.Text
cellVal20 = Me.TextBox16.Text
cellVal21 = Me.TextBox17.Text
cellVal22 = Me.TextBox18.Text
cellVal23 = Me.TextBox19.Text
cellVal24 = Me.TextBox20.Text
cellVal25 = Me.TextBox21.Text
cellVal26 = Me.TextBox22.Text
cellVal27 = Me.TextBox23.Text
cellVal28 = Me.TextBox24.Text
cellVal29 = Me.TextBox25.Text
cellVal30 = Me.TextBox26.Text
cellVal31 = Me.TextBox27.Text
cellVal32 = Me.TextBox28.Text
cellVal33 = Me.TextBox29.Text
cellVal34 = Me.TextBox30.Text
RwLast = Worksheets(shtCmb).Range("AI" & Worksheets(shtCmb).Rows.Count).End(xlUp).Row
Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
Worksheets(shtCmb).Range("E" & RwLast + 1).Value = cellVal8
Worksheets(shtCmb).Range("F" & RwLast + 1).Value = cellVal9
Worksheets(shtCmb).Range("G" & RwLast + 1).Value = cellVal10
Worksheets(shtCmb).Range("H" & RwLast + 1).Value = cellVal11
Worksheets(shtCmb).Range("I" & RwLast + 1).Value = cellVal12
Worksheets(shtCmb).Range("J" & RwLast + 1).Value = cellVal13
Worksheets(shtCmb).Range("K" & RwLast + 1).Value = cellVal14
Worksheets(shtCmb).Range("L" & RwLast + 1).Value = cellVal15
Worksheets(shtCmb).Range("M" & RwLast + 1).Value = cellVal16
Worksheets(shtCmb).Range("N" & RwLast + 1).Value = cellVal17
Worksheets(shtCmb).Range("O" & RwLast + 1).Value = cellVal18
Worksheets(shtCmb).Range("P" & RwLast + 1).Value = cellVal19
Worksheets(shtCmb).Range("Q" & RwLast + 1).Value = cellVal20
Worksheets(shtCmb).Range("R" & RwLast + 1).Value = cellVal21
Worksheets(shtCmb).Range("S" & RwLast + 1).Value = cellVal22
Worksheets(shtCmb).Range("T" & RwLast + 1).Value = cellVal23
Worksheets(shtCmb).Range("U" & RwLast + 1).Value = cellVal24
Worksheets(shtCmb).Range("V" & RwLast + 1).Value = cellVal25
Worksheets(shtCmb).Range("W" & RwLast + 1).Value = cellVal26
Worksheets(shtCmb).Range("X" & RwLast + 1).Value = cellVal27
Worksheets(shtCmb).Range("Y" & RwLast + 1).Value = cellVal28
Worksheets(shtCmb).Range("Z" & RwLast + 1).Value = cellVal29
Worksheets(shtCmb).Range("AA" & RwLast + 1).Value = cellVal30
Worksheets(shtCmb).Range("AB" & RwLast + 1).Value = cellVal31
Worksheets(shtCmb).Range("AC" & RwLast + 1).Value = cellVal32
Worksheets(shtCmb).Range("AD" & RwLast + 1).Value = cellVal33
Worksheets(shtCmb).Range("AF" & RwLast + 1).Value = cellVal34
Application.EnableEvents = True
End Sub
Private Sub cmbListItem1_Change()
End Sub
Private Sub optionCancel_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
回答by B Hart
You could try something like the below within your UserForm Code:
您可以在您的用户窗体代码中尝试如下操作：
Option Explicit
Dim WrkSheet As Worksheet
Private Sub ComboBox1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
End Sub
Then in the rest of your UserForm code you should be able to reference the correct sheet by: Example
然后在您的用户表单代码的其余部分中，您应该能够通过以下方式引用正确的工作表：示例
MsgBox WrkSheet.Range("A1").Value
EDIT: Added code
编辑：添加代码
Option Explicit
Dim WrkSheet As Worksheet
Private Sub btnSubmit_Click()
Dim SSheet As Workbook
Dim NR As Long
NR = SSheet.Cells(Rows.Count, 1).Row + 1
'Not sure what you are trying to do below ???
SSheet.Cells(NR, 1) = "???"
End Sub
Private Sub cmbListItem1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
WrkSheet.Range("AI2").Value = Me.cmbListItem1.Text
End Sub
Private Sub cmbListItem2_Change()
WrkSheet.Range("AJ2").Value = Me.cmbListItem2.Text
End Sub
Private Sub cmbListItem3_Change()
WrkSheet.Range("A2").Value = Me.cmbListItem3.Text
End Sub
Private Sub tbDate_Click()
WrkSheet.Range("AH2").Value = Me.tbDate.Text
End Sub
Private Sub TextBox1_Change()
WrkSheet.Range("B2").Value = Me.TextBox1.Text
End Sub
Private Sub TextBox2_Change()
WrkSheet.Range("C2").Value = Me.TextBox2.Text
End Sub
Private Sub TextBox3_Change()
WrkSheet.Range("D2").Value = Me.TextBox3.Text
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(Month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
Me.tbDate = Date
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(Month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
The above is untested, but give it a try and see if it helps resolve your issue.
以上内容未经测试，但请尝试一下，看看它是否有助于解决您的问题。
EDIT: Added another code variation Below: The Below will add all UserForm Values to the Sheet with the Month Name Selected in the List. I kept the original Columns used in your example.
编辑：在下面添加了另一个代码变体：下面将使用列表中选择的月份名称将所有用户窗体值添加到工作表中。我保留了您的示例中使用的原始列。
Option Explicit
Dim WrkSheet As Worksheet
Private Sub btnSubmit_Click()
Dim NR As Long
Application.ScreenUpdating = False
With WrkSheet
NR = .UsedRange.Rows.Count + 1
'If there is a specific column (Example: A) you can use
'NR = .Range("A" & .UsedRange.Rows.Count).End(xlUp).Row + 1
.Range("AI" & NR).Value = Me.cmbListItem1.Text
.Range("AJ" & NR).Value = Me.cmbListItem2.Text
.Range("A" & NR).Value = Me.cmbListItem3.Text
.Range("AH" & NR).Value = Me.tbDate.Text
.Range("B" & NR).Value = Me.TextBox1.Text
.Range("C" & NR).Value = Me.TextBox2.Text
.Range("D" & NR).Value = Me.TextBox3.Text
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmbListItem1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
Set WrkSheet = Sheet3 ' You can Change or Remove This if you choose
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(Month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
Me.tbDate = Date
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(Month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
回答by Ratafia
If your first combobox will only have the names of your sheets, you could use this instead to shorten your code significantly:
如果您的第一个组合框只有您的工作表名称，您可以使用它来显着缩短您的代码：
Private Sub cmbListItem1_Change()
Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem1.Text
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
Worksheets(shtCmb).Range("AI2").Value = cellVal
End Sub
For each of your combobox inputs, you can just change the output variable for the cell's value.
对于每个组合框输入，您只需更改单元格值的输出变量即可。
Private Sub cmbListItem2_Change()
Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem2.Text
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
Worksheets(shtCmb).Range("AJ2").Value = cellVal
End Sub
However, this code should change the values of the cells in those sheets every time a change is made. If that's what you want, this should do it. If you want it to input all of the values when you click an enter button, I can help with that too.
但是，每次进行更改时，此代码都应更改这些工作表中单元格的值。如果这就是你想要的，这应该可以。如果您希望它在您单击输入按钮时输入所有值，我也可以提供帮助。
EDIT:
编辑：
I've changed the code to update the cells on your accept button click event (what I'm assuming to be an accept button anyways) and update the next empty cells below whatever is already in there. This code assumes that some values are already in row 1, most likely headers. Give this a shot on a copy of your workbook, not the actual one, and it should work. I am unable to test this as I don't have a copy of your working data.
我已经更改了代码以更新接受按钮单击事件上的单元格（无论如何我假设它是接受按钮）并更新那里已经存在的下一个空单元格。此代码假定某些值已在第 1 行中，很可能是标题。在您的工作簿的副本上试一试，而不是实际的副本，它应该可以工作。我无法对此进行测试，因为我没有您的工作数据的副本。
Private Sub btnSubmit_Click()
Dim ssheet As Workbook
Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String
Dim cellVal6 As String, cellVal7 As String
Dim shtCmb As String
Dim RwLast As Long
shtCmb = Me.cmbListItem1.Value
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.tbDate.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text
RwLast = Range("AI" & ActiveSheet.Rows.Count).End(xlUp).Row
Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
End Sub
Private Sub UserForm_Initialize()
Me.tbDate = Date
'fill the combo box
For Each entry In [List1]
Me.cmbListItem1.AddItem entry
Next entry
'fill the combo box
For Each entry In [List2]
Me.cmbListItem2.AddItem entry
Next entry
'fill the combo box
For Each entry In [List3]
Me.cmbListItem3.AddItem entry
Next entry
End Sub
Note that this is a very clumsy way of completing this code on my part, I know there should be a better way to iterate between your ranges and entry values, but as I am not a master this is the simplest way to complete the code.
请注意，这是我完成此代码的一种非常笨拙的方式，我知道应该有更好的方法在您的范围和条目值之间进行迭代，但由于我不是大师，这是完成代码的最简单方法。
