Aktualisiert: 12:23AM - Arbeitscode
Ich stecke derzeit fest. Im Moment fügt es nur das letzte Vorkommen des gefundenen Ergebnisses ein und ich möchte, dass es alle separat in das Listenfeld einfügt, aber ich kann es nicht herausfinden, egal wie ich es versuche. Ich habe versucht, AddItem, Range, Text, Value, alle möglichen Tricks, die ich bei Google gefunden habe, zu verwenden, um es zum Laufen zu bringen, aber alles, was ich erhalte, sind Fehler oder nur ein Eintrag ... Hier ist, was ich bisher habe. Das Ich. Zeug ist Teil meiner Benutzerform, die alle Textfelder sind, alles, was aus Excel gezogen wird, ist allgemein und hat keinen bestimmten Typ.
Dies ist mein gesamter Code für diese Schaltfläche. Meine Probleme sind im Search_Click Sub, aber es kann an anderen Stellen liegen, also habe ich den gesamten Code angegeben. Lassen Sie es mich wissen, wenn Sie weitere Informationen benötigen. Es gibt keine Tabellen im Excel-Dokument und nichts Besonderes, nur eine Reihe von Zellen mit einigen so eingerichteten Informationen. Jede eine Spalte
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
Ich habe es herausgefunden. Der aktualisierte und funktionierende Code befindet sich oben in meiner ursprünglichen Frage. Ich habe versucht, mehrere Elemente mit einer .List = . hinzuzufügen
Mir war nicht bewusst, dass ich 10 Spalten hatte, die alle separat ausgefüllt werden mussten.
Dieser Artikel stammt aus dem Internet. Bitte geben Sie beim Nachdruck die Quelle an.
Bei Verstößen wenden Sie sich bitte [email protected] Löschen.
Lass mich ein paar Worte sagen