输入框作为下拉列表(ComboBox)

时间:2018-10-23 14:31:10

标签: excel vba excel-vba

我希望我的inputBox成为具有以下选择的ComboBox:Admin,Associate等(请参见下面的ComboBox代码)。

Private Sub ComboBox1_Change()
With ComboBox1
        .AddItem "Admin"
        .AddItem "Associate"
        .AddItem "Analyst"
        .AddItem "Consultant"
        .AddItem "Senior Consultant"
        .AddItem "Director"
        .AddItem "Principal Consultant"
        .AddItem "Managing Principal"
        .AddItem "Partner"
        .AddItem "Managing Partner"
    End With

End Sub

我希望能够选择这些选项之一并将其存储为字符串(在我的代码中为“ Position”),然后在我的代码中重复使用它。

还可以将组合框选项分配给新字符串吗?例如

Admin = Adm; Associate = A等等。

请在下面找到我的代码:

Sub ssNewJoinerM()

Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String

    QuestionToMessageBox = "Do you want to add someone to a Hub ?"

    YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "New joiner Process")

If YesOrNoAnswerToMessageBox = vbYes Then

    GoTo Start
    Else: GoTo Finish

End If

Start:

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet
Dim ws8 As Worksheet

Set ws1 = ActiveSheet
Set ws2 = ActiveSheet
Set ws3 = ActiveSheet
Set ws4 = ActiveSheet
Set ws5 = ActiveSheet
Set ws6 = ActiveSheet
Set ws7 = ActiveSheet
Set ws8 = ActiveSheet

Set ws1 = ThisWorkbook.Sheets("Monthly Movements")
Set ws2 = ThisWorkbook.Sheets("Howard-Marle Hub")
Set ws3 = ThisWorkbook.Sheets("Bernard Hub")
Set ws4 = ThisWorkbook.Sheets("Thomas Hub")
Set ws5 = ThisWorkbook.Sheets("Michael Hub")
Set ws6 = ThisWorkbook.Sheets("Oliver Hub")
Set ws7 = ThisWorkbook.Sheets("Lance Hub")
Set ws8 = ThisWorkbook.Sheets("John Hub")

Dim table1 As ListObject
Dim table2 As ListObject
Dim table3 As ListObject
Dim table4 As ListObject
Dim table5 As ListObject
Dim table6 As ListObject
Dim table7 As ListObject
Dim table8 As ListObject
Dim table9 As ListObject
Dim table10 As ListObject
Dim table11 As ListObject
Dim table12 As ListObject
Dim table13 As ListObject
Dim table14 As ListObject
Dim table15 As ListObject

Set table1 = ws2.ListObjects("Table1")
Set table2 = ws2.ListObjects("Table2")
Set table3 = ws1.ListObjects("Table3")
Set table4 = ws3.ListObjects("Table4")
Set table5 = ws3.ListObjects("Table5")
Set table6 = ws4.ListObjects("Table6")
Set table7 = ws4.ListObjects("Table7")
Set table8 = ws5.ListObjects("Table8")
Set table9 = ws5.ListObjects("Table9")
Set table10 = ws6.ListObjects("Table10")
Set table11 = ws6.ListObjects("Table11")
Set table12 = ws7.ListObjects("Table12")
Set table13 = ws7.ListObjects("Table13")
Set table14 = ws8.ListObjects("Table14")
Set table15 = ws8.ListObjects("Table15")

Dim NewJoiner As String
NewJoiner = InputBox("Enter new joiner name in the following format (Surname, First Name)", "Adding New Joiner to Hub")
Dim Position As String
Position = InputBox("Enter new joiner Position (A, C, SC, PC, MP, Partner, Admin, Analyst, Director)", "Assigning New Joiner to a position")
'Input Name and Position and stores it (Could be improved with user form...)

1 个答案:

答案 0 :(得分:1)

您提出的问题包括三个部分。

  1. 以正确的方式填充组合框
  2. 使用组合框的值
  3. 将组合框的值链接到同义词,例如“ C”代表“咨询”
  4. (有关代码的样式建议)

关于1 : 打开工作表时,应填充组合框。为此,请使用打开有关工作簿时自动调用的Workbook_Open()方法。 “ VBAProject”(或您的项目名称是什么)->“ Microsoft Excel Objects”->“ ThisWorkbook”

Private Sub Workbook_Open()
    ' Instead of 1 enter the name of the worksheet which contains the combobox
    With ThisWorkbook.Worksheets(1).ComboBox1
        .AddItem "Admin"
        .AddItem "Associate"
        .AddItem "Analyst"
        .AddItem "Consultant"
        .AddItem "Senior Consultant"
        .AddItem "Director"
        .AddItem "Principal Consultant"
        .AddItem "Managing Principal"
        .AddItem "Partner"
        .AddItem "Managing Partner"
    End With
End Sub

您使用的“ ComboBox1_Change()”方法每次用户更改组合框的值时都会触发一个事件。

关于2 : 我认为代码对于这部分是不言自明的。您每次都可以引用组合框的值。

Dim dropdown        As ComboBox
Dim dropdown_value  As String

Set dropdown = ThisWorkbook.Worksheets(1).ComboBox1
dropdown_value = dropdown.Value

关于3 :您应该对此有更多的了解。根据该问题的答案,如何执行此问题的答案将有所不同。 通常,您要做的是一种“映射”。我建议只使用一个数组,并具有类似翻译的功能:

Function MappingArray(ByVal input_string As String) As Variant

    ' Size an two-dimensional array
    Dim mapping(0 To 9, 0 To 1)     As Variant
    Dim i                           As Integer

    ' fill the first dimension with mapping of full names
    mapping(0, 0) = "Admin"
    mapping(1, 0) = "Associate"
    mapping(2, 0) = "Analyst"
    mapping(3, 0) = "Consultant"
    mapping(4, 0) = "Senior Consultant"
    mapping(5, 0) = "Director"
    mapping(6, 0) = "Principal Consultant"
    mapping(7, 0) = "Managing Principal"
    mapping(8, 0) = "Partner"
    mapping(9, 0) = "Managing Partner"
    ' fill the second dimension with regarding shortcuts
    mapping(0, 1) = "Ad"
    mapping(1, 1) = "A"
    mapping(2, 1) = "An"
    mapping(3, 1) = "C"
    mapping(4, 1) = "SC"
    mapping(5, 1) = "Dir"
    mapping(6, 1) = "PC"
    mapping(7, 1) = "MPr"
    mapping(8, 1) = "P"
    mapping(9, 1) = "MP"

    ' loop throught the array until you find the value
    For i = LBound(mapping, 1) To UBound(mapping, 1)
        If input_string = mapping(i, 0) Then
            ' assign the opposite value to the function
            MappingArray = mapping(i, 1)
            ' exit, because you are done
            Exit Function
        ElseIf input_string = mapping(i, 1) Then
            ' assign the opposite value to the function
            MappingArray = mapping(i, 0)
            ' exit, because you are done
            Exit Function
        End If
    Next i

    MappingArray = "Error: Value not found"

End Function

关于4 :停止使用“转到”。最好否定您的if语句,例如:

If MsgBox(QuestionToMessageBox, vbYesNo, "New joiner Process") = vbNo Then
    Exit Sub
End If

如果您还有其他问题,请随时提问。 欢呼