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

时间:2019-01-18 19:28:33

标签: excel vba

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

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

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

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

2 个答案:

答案 0 :(得分:0)

在这里尝试一下,看看是否能解决您的问题。该代码基本上执行相同的操作,但是在内存中工作而不是与对象进行过多交互。

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

答案 1 :(得分:0)

您可以一起避免循环。使用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