VBA 在用户表单上生成的下拉组合框和文本框

Question

基本上，我有一个我想制作的对话框

如果你能看到上面的内容，我想将组合框应用于 BDI Industry Group 和 CIF 的搜索。

然后，每当我点击“按行业组别搜索”组合框并选择一个时，CIF 字段会为您提供另一个下拉列表供您选择，然后，其他字段的其余部分将根据下面的数据自动填写

上面的截图只是我数据库的一小部分。一共7504行，表头从A2开始。

假设我选择交通工具

然后我希望 CIF 字段显示 CIF 13039099 和 12901262 的下拉列表供我选择。

接下来比如我选的是CIF 13039099，其他字段会直接根据数据库自动显示信息，即：

客户姓名：Adit Jaya Mandiri 的简历
RM 姓名：Irawan Noor
片段：商业

并且我希望客户名称、RM 名称 和细分市场 是可编辑的。

之后当我点击保存时，它会根据最新的变化自动更新。这可以执行吗？下面是 VBA 代码，我根据其他 post

中某人的评论修改了代码

'Codes to form
Option Explicit
Private matchRow As Long

Private Sub Combobox1_Change()
Dim rng As Range, cel As Range
Dim lstrow As Long
Dim strBDI As String

    strBDI = Me.ComboBox1

    lstrow = Cells(ActiveSheet.Rows.Count, "N").End(xlUp).Row 'Change column N with BDI column in case of you.
    Set rng = ActiveSheet.Range("N3:N" & lstrow)


    Me.ComboBox2.Clear
    For Each cel In rng
        If cel = strBDI Then
            Me.ComboBox2.AddItem cel.Offset(0, -13) '-13 need to adjust with CIF column left from BDI column
        End If
    Next

End Sub

Private Sub Combobox2_Change()
Dim rng As Range, cel As Range
Dim lstrow As Long
Dim strBDI As String
Dim strCIF As String

    strBDI = Me.ComboBox1
    strCIF = Me.ComboBox2

    lstrow = Cells(ActiveSheet.Rows.Count, "N").End(xlUp).Row 'Change column N with BDI column in case of you.
    Set rng = ActiveSheet.Range("N3:N" & lstrow)

    For Each cel In rng
        If cel = strBDI And cel.Offset(0, -13) = strCIF Then
            matchRow = cel.Row
            Exit For
        End If
    Next

    Me.TextBox1 = ActiveSheet.Cells(matchRow, 2)
    Me.TextBox2 = ActiveSheet.Cells(matchRow, 6)
    Me.TextBox3 = ActiveSheet.Cells(matchRow, 13)


End Sub

Private Sub cmdSave_Click()

    ActiveSheet.Cells(matchRow, 2) = Me.TextBox1
    ActiveSheet.Cells(matchRow, 6) = Me.TextBox2
    ActiveSheet.Cells(matchRow, 13) = Me.TextBox3

    MsgBox "Data Saved Successfully!", vbInformation, "Save"

End Sub

    
Private Sub UserForm_Initialize()

'Add items manually or use sub to add unique items from BDI Column

    Me.ComboBox1.AddItem "AUTOMOTIVE ATPM & DEALER"

    Me.ComboBox1.AddItem "AUTOMOTIVE COMPONENT"

    Me.ComboBox1.AddItem "CABLE"

    Me.ComboBox1.AddItem "CEMENT"

    Me.ComboBox1.AddItem "CHEMICAL"

    Me.ComboBox1.AddItem "chemical & PLASTICS"

    Me.ComboBox1.AddItem "COAL INDUSTRY"

    Me.ComboBox1.AddItem "COMPUTER & RELATED"

    Me.ComboBox1.AddItem "CONSTRUCTION"

    Me.ComboBox1.AddItem "COSMETICS & TOILETRIES"

    Me.ComboBox1.AddItem "CPO INDUSTRY"

    Me.ComboBox1.AddItem "ELECTRICITY & POWER PLANT"

    Me.ComboBox1.AddItem "ENGINE MACHINERIES & TOOLS"

    Me.ComboBox1.AddItem "FARMING & ANIMAL FEED"

    Me.ComboBox1.AddItem "FINANCIAL SERVICES"

    Me.ComboBox1.AddItem "FISHERIES"

    Me.ComboBox1.AddItem "FOOD & BEVERAGE"

    Me.ComboBox1.AddItem "FORESTRY & WOOD PRODUCT"

    Me.ComboBox1.AddItem "FURNITURE"

    Me.ComboBox1.AddItem "GARMENT"

    Me.ComboBox1.AddItem "HOME APPLIANCES"

    Me.ComboBox1.AddItem "HOSPITAL & HEALTHCARE"

    Me.ComboBox1.AddItem "HOTEL & ACCOMMODATION SERVICE"

    Me.ComboBox1.AddItem "INFRASTRUCTURE"

    Me.ComboBox1.AddItem "MEDICAL EQUIPMENT"

    Me.ComboBox1.AddItem "METAL NON STEEL"

    Me.ComboBox1.AddItem "MINING & QUARRING"

    Me.ComboBox1.AddItem "OIL & GAS - DOWNSTREAM"

    Me.ComboBox1.AddItem "OIL & GAS - UPSTREAM"

    Me.ComboBox1.AddItem "OTHERS"

    Me.ComboBox1.AddItem "PACKAGING & CORRUGATED"

    Me.ComboBox1.AddItem "PETROCHEMICAL & PLASTICS"

    Me.ComboBox1.AddItem "PHARMACEUTICAL"

    Me.ComboBox1.AddItem "PRINTING"

    Me.ComboBox1.AddItem "PROPERTIES & REAL ESTATE"

    Me.ComboBox1.AddItem "PULP & PAPER"

    Me.ComboBox1.AddItem "RENTAL SERVICES"

    Me.ComboBox1.AddItem "RETAILER"

    Me.ComboBox1.AddItem "RUBBER INDUSTRY"

    Me.ComboBox1.AddItem "SERVICE INDUSTRY"

    Me.ComboBox1.AddItem "SHIPPING"

    Me.ComboBox1.AddItem "STEEL"

    Me.ComboBox1.AddItem "SUGAR INDUSTRY"

    Me.ComboBox1.AddItem "TELECOMMUNICATION"

    Me.ComboBox1.AddItem "TEXTILE"

    Me.ComboBox1.AddItem "TOBACCO & CIGARETTE"

    Me.ComboBox1.AddItem "TRANSPORTATION"

    Me.ComboBox1.AddItem "WHOLESALES TRADING"
    
End Sub

但还是没有如我所愿。每当我在BDI工业集团中挑选一个时，CIF就出不来。

如有任何帮助，我们将不胜感激。

谢谢。

Answer 1

看来您的（主要）问题是分析列中存在“#NA”错误，必须转义这些行：

在ComboBox1 Change事件中，我建议你使用：

Private Sub Combobox1_Change()
 Dim rng As Range, cel As Range, lstrow As Long, strBDI As String

    strBDI = Me.ComboBox1.Value

    lstrow = Worksheets("Lending & Funding").Cells(Worksheets("Lending & Funding") _
                 .Rows.Count, "N").End(xlUp).Row
    Set rng = Worksheets("Lending & Funding").Range("N3:N" & lstrow)
    Me.ComboBox2.Clear
    
    For Each cel In rng.Cells
        If Not IsError(cel.Value) Then
            If cel.Value = strBDI Then
                Me.ComboBox2.AddItem cel.Offset(0, -13) '-13 need to adjust with CIF column left from BDI column
            End If
        End If
    Next
End Sub

并且对 ComboBox2 使用相同的方法 Event:

Private Sub Combobox2_Change()
 Dim rng As Range, cel As Range, lstrow As Long
 Dim strBDI As String, strCIF As String

    strBDI = Me.ComboBox1.Value: strCIF = Me.ComboBox2.Value
    
    lstrow = Worksheets("Lending & Funding").Cells(Worksheets("Lending & Funding") _
       .Rows.Count, "N").End(xlUp).Row 'Change column N with BDI column in case of you.
    Set rng = Worksheets("Lending & Funding").Range("N3:N" & lstrow)

    For Each cel In rng
        If Not IsError(cel.Value) Then
            If cel = strBDI And cel.Offset(0, -13) = strCIF Then
                matchRow = cel.Row
                Exit For
            End If
        End If
    Next

    If matchRow > 0 Then 'sometimes, the above conditions may not return any match...
        Me.TextBox1 = Worksheets("Lending & Funding").Cells(matchRow, 2)
        Me.TextBox2 = Worksheets("Lending & Funding").Cells(matchRow, 6)
        Me.TextBox3 = Worksheets("Lending & Funding").Cells(matchRow, 13)
    Else
        MsgBox "There is no mathch for the chosen criteria..."
    End If
End Sub

那么ComboBox1的加载方式（手动设置唯一值）就不是最efficient/appropriate...

请试试这个方法：

Private Sub UserForm_Initialize()
 Dim shLF As Worksheet, dict As New Scripting.Dictionary, lastRow As Long
 Dim I As Long, lastCol As Long, arr As Variant
 
 Set shLF = Worksheets("Lending & Funding")
 lastRow = shLF.Range("N" & Rows.Count).End(xlUp).Row
 lastCol = shLF.Cells(2, Columns.Count).End(xlToLeft).Column + 2
 
 For I = 3 To lastRow
    If Not dict.Exists(shLF.Range("N" & I).Value) Then
        dict.Add shLF.Range("N" & I).Value, 1
    End If
 Next I
 'sort the dictionary, load the sorted column in an array, clear the temporary range and load combo:
 shLF.Cells(1, lastCol).Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Keys)
 With shLF.Range(shLF.Cells(1, lastCol), shLF.Cells(1, lastCol).Resize(dict.Count, lastCol))
    .Sort shLF.Cells(1, lastCol), xlAscending
    arr = .Value
    .Clear
 End With
 Me.ComboBox1.List = arr
 'clear zero BDI (if necessary):
 For I = 0 To Me.ComboBox1.ListCount - 1
    If Me.ComboBox1.List(I) = "0" Then Me.ComboBox1.RemoveItem (I): Exit For
 Next I
End Sub

最好（我认为）以一种能够单击、滚动、编辑页面单元格的方式显示表单：

Private Sub CommandButton2_Click()
    BDIIndustryGroup.Show vbModeless
End Sub

已编辑：

'SAVE' 按钮的代码，能够填回您在文本框中更改的值。现在，它选择保存的行，以便您检查结果...

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  
  Set sh = Worksheets("Lending & Funding")

  sh.Cells(matchRow, 2) = Me.TextBox1
  sh.Cells(matchRow, 6) = Me.TextBox2
  sh.Cells(matchRow, 13) = Me.TextBox3

  sh.Cells(matchRow, 2).EntireRow.Select
  
  MsgBox "Data Saved Successfully!", vbInformation, "Save"
End Sub

VBA 在用户表单上生成的下拉组合框和文本框

Dropdown Combobox and Textbox Generated on Userform with VBA

excel

vba

textbox

userform

dropdown