在组合框中进行选择时不填充文本框

Question

我创建了一个将数据添加到电子表格的表单。其中有一个组合框，显示已添加到电子表格中的公司。我正在尝试创建代码来填充文本框。

这是一个供应商电子表格，可让人们更轻松地查找、编辑、删除和添加供应商。我已经为添加按钮创建了表单和代码，并填充了三个组合框。这些组合框从我定义列表的工作簿的单独工作表中的列表中获取数据。我一直在尝试使用与组合框中选择的公司匹配的行中的数据填充表单的文本框。我一直在玩弄第四行代码，让它形成一个范围，从该范围中可以在包含所有公司数据的工作表上查找公司名称。我遇到了许多不同的错误，这是第一个没有给出错误但也没有执行任何操作的代码。

Private Sub cboCo_Change()
    Dim iRow As Long, LastRow As Long
    Dim ws1 As Worksheet
    Set ws1 = Sheet3
    LastRow = ws1.Range(Cells(1, 1), Cells(300, 1)).End(xlUp).Row
    'LastRow = ws1.Cells(1, Rows.Count).End(xlUp).Row

    For iRow = 2 To LastRow
        'I changed sheets("VendorList") to ws1 so wherever you see ws1 was previously sheets("VendorList")
        If Sheet3.Cells(i, "A").Value = (Me.cboCo) Then
           Me.txtContact = ws1.Cells(i, "B")
           Me.txtPhone = ws1.Cells(i, "C")
           Me.txtEmail = ws1.Cells(i, "D")
           Me.txtCoAdd = ws1.Cells(i, "E")
           Me.txtWebSite = ws1.Cells(i, "F")
           Me.txtServProd = ws1.Cells(i, "G")
           Me.txtAccred = ws1.Cells(i, "H")
           Me.txtStanding = ws1.Cells(i, "I")
           Me.txtSince = ws1.Cells(i, "J")
           Me.txtNotes = ws1.Cells(i, "K")
           Me.txtVerified = ws1.Cells(i, "L")
           Me.txtToday = ws1.Cells(i, "M")
           Me.cboYrApprv = ws1.Cells(i, "N")
           Me.txtApprvBy = ws1.Cells(i, "O")
           Me.txtAprvReas = ws1.Cells(i, "P")
           Me.txtOrder = ws1.Cells(i, "Q")
           Me.txtPurchs = Sheets("VendorList").Cells(i, "R")
           Me.cboCat = Sheets("VendorList").Cells(i, "S")
        End If
    Next iRow
End Sub

它应该查看组合框中的名称，在工作表中找到名称，然后将行中的文本放入相应的文本框中，但它不执行任何操作。我也没有收到错误。

Answer 1

您可以一起避免循环。使用Range.Find 方法在Me.cboCo 中搜索您的值。如果找到您的值，我们将使用该行填充您的文本框。

您可以修改.Find 方法上的选项以优化搜索。见here

---

Private Sub cboCo_Change()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet3")
Dim Found As Range, i As Long

Set Found = ws.Range("A:A").Find(Me.cboCo)

If Not Found Is Nothing Then
  i = Found.Row
    Me.txtContact = ws.Cells(i, "B")
    Me.txtPhone = ws.Cells(i, "C")
    Me.txtEmail = ws.Cells(i, "D")
    Me.txtCoAdd = ws.Cells(i, "E")
    Me.txtWebSite = ws.Cells(i, "F")
    Me.txtServProd = ws.Cells(i, "G")
    Me.txtAccred = ws.Cells(i, "H")
    Me.txtStanding = ws.Cells(i, "I")
    Me.txtSince = ws.Cells(i, "J")
    Me.txtNotes = ws.Cells(i, "K")
    Me.txtVerified = ws.Cells(i, "L")
    Me.txtToday = ws.Cells(i, "M")
    Me.cboYrApprv = ws.Cells(i, "N")
    Me.txtApprvBy = ws.Cells(i, "O")
    Me.txtAprvReas = ws.Cells(i, "P")
    Me.txtOrder = ws.Cells(i, "Q")
    Me.txtPurchs = Sheets("VendorList").Cells(i, "R")
    Me.cboCat = Sheets("VendorList").Cells(i, "S")
End If

End Sub

Answer 2

在这里尝试一下，看看它是否能解决您的问题。这段代码基本上做同样的事情，但在内存中工作，而不是与对象进行太多交互。

Private Sub cboCo_Change()
    Dim i As Long
    dim arr as variant
    arr=thisworkbook.worksheets("Sheet3").UsedRange
    For i = 2 To UBound(arr,1)
        If arr(i, 1) = Me.cboCo.value Then
           Me.txtContact = arr(i, 2)
           Me.txtPhone = arr(i, 3)
           Me.txtEmail = arr(i, 4)
           Me.txtCoAdd = arr(i, 5)
           Me.txtWebSite = arr(i, 6)
           Me.txtServProd = arr(i, 7)
           Me.txtAccred = arr(i, 8)
           Me.txtStanding = arr(i, 9)
           Me.txtSince = arr(i, 10)
           Me.txtNotes = arr(i, 11)
           Me.txtVerified = arr(i, 12)
           Me.txtToday = arr(i, 13)
           Me.cboYrApprv =arr(i, 14)
           Me.txtApprvBy = arr(i, 15)
           Me.txtAprvReas = arr(i, 16)
           Me.txtOrder = arr(i, 17)
           Me.txtPurchs = arr(i, 18)
           Me.cboCat = arr(i, 19)
        End If
    Next i
    FormName.Repaint
End Sub