Текстовые поля не заполняются при выделении в выпадающем списке

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, чтобы оптимизировать поиск. Смотри здесь

---

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