如何根据用户表单中列表框中的选择填充电子表格中的单元格

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