如何根据用户表单中列表框中的选择填充电子表格中的单元格
How to populate cell in spreadsheet from selection made in listbox in userform
我在这方面是全新的,并且被困在听起来很简单的事情上。
我创建了简单的用户表单,组装人员将在其中输入其中一项作为搜索条件。然后,列表框将填充来自原始电子表格的所有结果,显示该部分的位置。然后,组装人员将 select 他们需要挑选的一项,然后单击“挑选”按钮。
要做的是在电子表格的“PickDate”中输入日期。这就是我被困的地方。
我的想法是 select 电子表格中的行与列表框中 selected 行相同,然后使用该行和列创建单元格的地址。但它不起作用。尝试了一些我可以在互联网上找到的东西,但没有任何效果。有一次我在正确的列中输入了日期,但没有在正确的行中输入。不幸的是,不记得那个代码是什么了。
任何帮助,将不胜感激。
非常感谢。 userform spreadsheet
Private Sub PickBtn_Click()
Dim i As Integer
For i = 1 To Range("A10000").End(xlUp).Row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
.Range(Selection, 7).Value = Date
End If
Next i
End Sub
Entry form
Private Sub CancelJob_Click()
'Close EntryForm form
Unload EntryForm
'Show InitialForm form
InitialForm.Show
End Sub
Private Sub UserForm_Initialize()
'Empty all fields
JobBox.Value = ""
Customer.Value = ""
Location.Value = ""
Rack.Value = ""
'Fill combo box with product types
With ProductCombo
.AddItem "Channel Letter Faces"
.AddItem "Channel Letter Backers"
.AddItem "Routed Aluminum Panels"
.AddItem "Routed ACM Panels"
End With
'Set focus on Work order TextBox
JobBox.SetFocus
End Sub
Private Sub SubmitJob_Click()
'Make fields mandatory
If JobBox.Value = "" Or ProductCombo.Value = "" Or Rack.Value = "" Then
If MsgBox("Cannot submit. Please fill the mandatory fields.",
vbQuestion + vbOKOnly) <> vbOKOnly Then
Exit Sub
End If
End If
'Start transfering process
Dim emptyRow As Long
'Make Sheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information to the table
Cells(emptyRow, 1).Value = Date 'Auto populate 1st column with submission date
Cells(emptyRow, 2).Value = JobBox.Value
Cells(emptyRow, 3).Value = Customer.Value
Cells(emptyRow, 4).Value = Location.Value
Cells(emptyRow, 5).Value = ProductCombo.Value
Cells(emptyRow, 6).Value = Rack.Value
'Save workbook after transfer of data
ActiveWorkbook.Save
'Close EntryForm
Unload Me
'Quit application so that others can use it
'Application.Quit
End Sub
这是我无法完成的用户表单搜索部分的完整代码
弄清楚(我正在玩我被卡住的“提交”按钮的代码)。也许它有助于解决问题:
Private Sub ClearForm(Except As String)
' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it
Select Case Except
Case "Job"
FormEvents = False
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Customer"
FormEvents = False
Job.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Location"
FormEvents = False
Job.Value = ""
Customer.Value = ""
Results.Clear
FormEvents = True
Case Else
FormEvents = False
Job.Value = ""
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
End Select
End Sub
Private Sub ClearBtn_Click()
ClearForm ("")
End Sub
Private Sub Job_Change()
If FormEvents Then ClearForm ("Job")
End Sub
Private Sub Customer_Change()
If FormEvents Then ClearForm ("Customer")
End Sub
Private Sub Location_Change()
If FormEvents Then ClearForm ("Location")
End Sub
Private Sub PickBtn_Click()
Dim i As Integer
Sheet1.Activate
For i = 1 To Range("A10000").End(xlUp).row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
Me.Range("Selection:G").Value = Date
End If
Next i
End Sub
Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' Display an error if no search term is entered
If Job.Value = "" And Customer.Value = "" And Location.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Work out what is being searched for
If Job.Value <> "" Then
SearchTerm = Job.Value
SearchColumn = "Job"
End If
If Customer.Value <> "" Then
SearchTerm = Customer.Value
SearchColumn = "Customer"
End If
If Location.Value <> "" Then
SearchTerm = Location.Value
SearchColumn = "Location"
End If
Results.Clear
' Only search in the relevant table column i.e. if somone is
searching Location
' only search in the Location column
With Range("Table1[" & SearchColumn & "]")
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' Set the first cell in the row of the matching value
Set FirstCell = Range("B" & RecordRange.row)
' Add matching record to List Box
Results.AddItem
Results.List(RowCount, 0) = FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1, 2)
Results.List(RowCount, 2) = FirstCell(1, 3)
Results.List(RowCount, 3) = FirstCell(1, 4)
Results.List(RowCount, 4) = FirstCell(1, 5)
Results.List(RowCount, 5) = FirstCell(1, 7)
RowCount = RowCount + 1
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
Results.AddItem
Results.List(RowCount, 0) = "Nothing Found"
End If
End With
End Sub
Private Sub UserForm_Initialize()
FormEvents = True
End Sub
在列表框中添加另一列以保存行号。
Results.List(RowCount, 6) = FirstCell.Row
然后代码变成
Private Sub PickBtn_Click()
Dim r as long
r = Results.List(Results.ListIndex,6)
Range(r, 7).Value = Date
End Sub
我在这方面是全新的,并且被困在听起来很简单的事情上。
我创建了简单的用户表单,组装人员将在其中输入其中一项作为搜索条件。然后,列表框将填充来自原始电子表格的所有结果,显示该部分的位置。然后,组装人员将 select 他们需要挑选的一项,然后单击“挑选”按钮。
要做的是在电子表格的“PickDate”中输入日期。这就是我被困的地方。
我的想法是 select 电子表格中的行与列表框中 selected 行相同,然后使用该行和列创建单元格的地址。但它不起作用。尝试了一些我可以在互联网上找到的东西,但没有任何效果。有一次我在正确的列中输入了日期,但没有在正确的行中输入。不幸的是,不记得那个代码是什么了。
任何帮助,将不胜感激。
非常感谢。 userform spreadsheet
Private Sub PickBtn_Click()
Dim i As Integer
For i = 1 To Range("A10000").End(xlUp).Row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
.Range(Selection, 7).Value = Date
End If
Next i
End Sub
Entry form
Private Sub CancelJob_Click()
'Close EntryForm form
Unload EntryForm
'Show InitialForm form
InitialForm.Show
End Sub
Private Sub UserForm_Initialize()
'Empty all fields
JobBox.Value = ""
Customer.Value = ""
Location.Value = ""
Rack.Value = ""
'Fill combo box with product types
With ProductCombo
.AddItem "Channel Letter Faces"
.AddItem "Channel Letter Backers"
.AddItem "Routed Aluminum Panels"
.AddItem "Routed ACM Panels"
End With
'Set focus on Work order TextBox
JobBox.SetFocus
End Sub
Private Sub SubmitJob_Click()
'Make fields mandatory
If JobBox.Value = "" Or ProductCombo.Value = "" Or Rack.Value = "" Then
If MsgBox("Cannot submit. Please fill the mandatory fields.",
vbQuestion + vbOKOnly) <> vbOKOnly Then
Exit Sub
End If
End If
'Start transfering process
Dim emptyRow As Long
'Make Sheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information to the table
Cells(emptyRow, 1).Value = Date 'Auto populate 1st column with submission date
Cells(emptyRow, 2).Value = JobBox.Value
Cells(emptyRow, 3).Value = Customer.Value
Cells(emptyRow, 4).Value = Location.Value
Cells(emptyRow, 5).Value = ProductCombo.Value
Cells(emptyRow, 6).Value = Rack.Value
'Save workbook after transfer of data
ActiveWorkbook.Save
'Close EntryForm
Unload Me
'Quit application so that others can use it
'Application.Quit
End Sub
这是我无法完成的用户表单搜索部分的完整代码 弄清楚(我正在玩我被卡住的“提交”按钮的代码)。也许它有助于解决问题:
Private Sub ClearForm(Except As String)
' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it
Select Case Except
Case "Job"
FormEvents = False
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Customer"
FormEvents = False
Job.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Location"
FormEvents = False
Job.Value = ""
Customer.Value = ""
Results.Clear
FormEvents = True
Case Else
FormEvents = False
Job.Value = ""
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
End Select
End Sub
Private Sub ClearBtn_Click()
ClearForm ("")
End Sub
Private Sub Job_Change()
If FormEvents Then ClearForm ("Job")
End Sub
Private Sub Customer_Change()
If FormEvents Then ClearForm ("Customer")
End Sub
Private Sub Location_Change()
If FormEvents Then ClearForm ("Location")
End Sub
Private Sub PickBtn_Click()
Dim i As Integer
Sheet1.Activate
For i = 1 To Range("A10000").End(xlUp).row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
Me.Range("Selection:G").Value = Date
End If
Next i
End Sub
Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' Display an error if no search term is entered
If Job.Value = "" And Customer.Value = "" And Location.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Work out what is being searched for
If Job.Value <> "" Then
SearchTerm = Job.Value
SearchColumn = "Job"
End If
If Customer.Value <> "" Then
SearchTerm = Customer.Value
SearchColumn = "Customer"
End If
If Location.Value <> "" Then
SearchTerm = Location.Value
SearchColumn = "Location"
End If
Results.Clear
' Only search in the relevant table column i.e. if somone is
searching Location
' only search in the Location column
With Range("Table1[" & SearchColumn & "]")
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' Set the first cell in the row of the matching value
Set FirstCell = Range("B" & RecordRange.row)
' Add matching record to List Box
Results.AddItem
Results.List(RowCount, 0) = FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1, 2)
Results.List(RowCount, 2) = FirstCell(1, 3)
Results.List(RowCount, 3) = FirstCell(1, 4)
Results.List(RowCount, 4) = FirstCell(1, 5)
Results.List(RowCount, 5) = FirstCell(1, 7)
RowCount = RowCount + 1
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
Results.AddItem
Results.List(RowCount, 0) = "Nothing Found"
End If
End With
End Sub
Private Sub UserForm_Initialize()
FormEvents = True
End Sub
在列表框中添加另一列以保存行号。
Results.List(RowCount, 6) = FirstCell.Row
然后代码变成
Private Sub PickBtn_Click()
Dim r as long
r = Results.List(Results.ListIndex,6)
Range(r, 7).Value = Date
End Sub