Как я могу использовать ListBox.List в Excel для вставки данных в список из функции поиска? - PullRequest
Новая
       0

Как я могу использовать ListBox.List в Excel для вставки данных в список из функции поиска?

0 голосов
/ 27 января 2020

Обновлено: 00:23 - рабочий код

В данный момент я застрял. Сейчас он вставляет только последнее вхождение найденного результата, и я хочу, чтобы он поместил их все отдельно в поле списка, но я не могу понять, как бы я ни пытался. Я пытался использовать AddItem, Range, Text, Value, все виды трюков, которые я нашел в Google, чтобы заставить его работать, но все, что я получаю, это ошибки или только одна запись ... Вот что у меня есть до сих пор. Я. вещи являются частью моей пользовательской формы, все текстовые поля, все, что извлекается из Excel, является общим и не имеет определенного типа c.

Это весь мой код для этой кнопки. Мои проблемы в Sub SearchCClick, но это могут быть и другие места, поэтому я дал весь код. Дайте мне знать, если вам нужна дополнительная информация. В документе Excel нет таблиц и нет ничего необычного, просто диапазон ячеек с некоторой информацией, настроенной так. Каждый столбец

Ювелирные изделия Описание Дата Офицер Время Дата (Возвращено) Офицер (Возвращено) Время (Возвращено) Возвращено 

Option Explicit
Dim wb As Workbook
Dim ws As Worksheet


Private Sub CommandButton1_Click()
  Dim i As Integer, sht As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i
    If (sht <> "") Then
    Set ws = wb.Worksheets(sht)
    Else
    MsgBox "Please Choose a Sheet"
    End If
End Sub

Private Sub Userform_Initialize()
    Set wb = Workbooks.Open("\\rh-utility03\home\bquigley\Book2.xlsx")
    ListBox1.Clear
End Sub

Private Sub Userform_Activate()
 Me.Jewelry.Value = ""
    Me.Description.Value = ""
    Me.Date_In.Value = ""
    Me.Officer_In.Value = ""
    Me.Time_In.Value = ""
    Me.Date_Out.Value = ""
    Me.Officer_Out.Value = ""
    Me.Time_Out.Value = ""
    Me.Returned.Value = ""
    Dim i As Integer, sht As String
    For Each ws In wb.Worksheets
    ListBox1.AddItem (ws.Name)
    Next ws
End Sub

Private Sub Clear_Click()
 Me.Jewelry.Value = ""
    Me.Description.Value = ""
    Me.Date_In.Value = ""
    Me.Officer_In.Value = ""
    Me.Time_In.Value = ""
    Me.Date_Out.Value = ""
    Me.Officer_Out.Value = ""
    Me.Time_Out.Value = ""
    Me.Returned.Value = ""
End Sub

Private Sub Search_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim rStr As String
    Dim lngLastRow As Long
    Dim lngRow As Long
    Dim strValue As String
    Dim lngRowOutput As Long
    Dim i As Long
    ' where does the data end in the Worksheet
    lngLastRow = ws.UsedRange.Rows.Count

    If lngLastRow = 1 Then Exit Sub ' no data
    Me.Results.Clear
    lngRowOutput = 2 ' where are we going to write the values to in Results List when we find a phrase
    i = 0
    For lngRow = 2 To lngLastRow
    If (Me.Description.Value <> "") Then
        strValue = ws.Cells(lngRow, 3).Value ' get value from column C
        If InStr(1, strValue, Me.Description.Value, vbTextCompare) > 0 Then ' can we find the string in the text
           With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)

           End With
            i = i + 1
            End If
    ElseIf (Me.Officer_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 5).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_In.Value, vbTextCompare) > 0 Then ' can we find the string in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Officer_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 8).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_Out.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Time_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 6).Value ' get value from column C
    If InStr(1, strValue, Me.Time_In.Text, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Time_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 9).Value ' get value from column C
    If InStr(1, strValue, Me.Time_Out.Text, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
            i = i + 1
        End If
        ElseIf (Me.Date_In.Value <> "") Then
    strValue = ws.Cells(lngRow, 4).Text ' get value from column C
    If InStr(1, strValue, Me.Date_In.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Date_Out.Value <> "") Then
    strValue = ws.Cells(lngRow, 7).Text ' get value from column C
    If InStr(1, strValue, Me.Date_Out.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
        ElseIf (Me.Returned.Value <> "") Then
    strValue = ws.Cells(lngRow, 10).Value ' get value from column C
    If InStr(1, strValue, Me.Officer_In.Value, vbTextCompare) > 0 Then ' can we find "MOTOR" in the text
             With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
    Else
         With Me.Results
           .ColumnWidths = "20,20,250"
           .AddItem
           .List(i, 0) = ws.Cells(lngRow, 1)
           .List(i, 1) = ws.Cells(lngRow, 2)
           .List(i, 2) = ws.Cells(lngRow, 3)
           .List(i, 3) = ws.Cells(lngRow, 4)
           .List(i, 4) = ws.Cells(lngRow, 5)
           .List(i, 5) = ws.Cells(lngRow, 6)
           .List(i, 6) = ws.Cells(lngRow, 7)
           .List(i, 7) = ws.Cells(lngRow, 8)
           .List(i, 8) = ws.Cells(lngRow, 9)
           .List(i, 9) = ws.Cells(lngRow, 10)
           End With
           i = i + 1
        End If
    Next lngRow
End Sub

Private Sub Modify_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Dim RowToModify As Long
    Set ws = wb.Worksheets(1)
    If (Me.Results.ListIndex <> -1 And Me.Results.Value <> "") Then
    RowToModify = Me.Results.Value
    Else: MsgBox "Select a Result to Modify"
    End If
    lRow = RowToModify + 1
    With ws
        Me.Jewelry.Value = .Cells(lRow, 2).Value
        Me.Description.Value = .Cells(lRow, 3).Value
        Me.Date_In.Value = .Cells(lRow, 4).Value
        Me.Officer_In.Value = .Cells(lRow, 5).Value
        Me.Time_In.Value = .Cells(lRow, 6).Value
        Me.Date_Out.Value = .Cells(lRow, 7).Value
        Me.Officer_Out.Value = .Cells(lRow, 8).Value
        Me.Time_Out.Value = .Cells(lRow, 9).Value
        Me.Returned.Value = .Cells(lRow, 10).Value
    End With
    'Clear input controls.
End Sub

Private Sub Submit_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Dim RowToModify As Long
    Set ws = wb.Worksheets(1)
     If (Me.Results.ListIndex <> -1) Then
    RowToModify = Me.Results.Value
    Else: MsgBox "Select a Result to Modify"
    End If
    lRow = RowToModify + 1
    With ws
        .Cells(lRow, 1).Value = RowToModify
        .Cells(lRow, 2).Value = Me.Jewelry.Value
        .Cells(lRow, 3).Value = Me.Description.Value
        .Cells(lRow, 4).Value = Me.Date_In.Value
        .Cells(lRow, 5).Value = Me.Officer_In.Value
        .Cells(lRow, 6).Value = Me.Time_In.Value
        .Cells(lRow, 7).Value = Me.Date_Out.Value
        .Cells(lRow, 8).Value = Me.Officer_Out.Value
        .Cells(lRow, 9).Value = Me.Time_Out.Value
        .Cells(lRow, 10).Value = Me.Returned.Value
    End With
    End Sub
Private Sub CloseButton_Click()
    'Close UserForm.
    Workbooks.Application.ActiveWorkbook.Save
    Workbooks.Application.ActiveWorkbook.Close
    Unload Me
End Sub

1 Ответ

0 голосов
/ 30 января 2020

Я понял это. Обновленный и рабочий код приведен выше в моем оригинальном вопросе. Я пытался добавить несколько элементов, используя один .List =

Я не понимал, что у меня есть 10 столбцов, которые необходимо заполнить по отдельности.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...