vba - 使用来自用户表单的数据更新工作表

Question

我有一张桌子，我有我建立的表格。

1. 用户通过表单中的组合框从表中选择姓名和姓氏
2. 用户需要从组合框中选择“是/否”关于此名称

我需要一个 vba 代码（excel），以便它可以在表中找到名称（在用户选择它之后），然后通过正确的行更新是/否列。

Answer 1

你需要做一些工作才能使它成为你需要的，但它应该让你开始：

Private Sub CommandButton1_Click()

Dim rng_ToSearch As Excel.Range
Dim rng_Found As Excel.Range

On Error GoTo ErrorHandler

'Change this to the range that contains your names. I'm assuming that
'it's a single column and has the Yes/No column alongside.
Set rng_ToSearch = Sheet1.Range("MyTable_Names")

'Change the What argument to reflect the name of your form's
'control.
Set rng_Found = rng_ToSearch.Find(What:=Me.ComboBox1.Value, _
    After:=rng_ToSearch.Range("A1"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)


'This shouldn't happen if you've populated the name selection
'box correctly and have not allowed users to add to it.
'This is left as an exercise for the reader.
If rng_Found Is Nothing Then
    Err.Raise vbObjectError + 2000, , "Either the selected name was " _
    & "not found in the list, or no selection was made."
End If

'Again, change the control name to your own.
rng_Found.Offset(0, 1) = Me.ComboBox2.Value

ExitPoint:
On Error Resume Next
Set rng_ToSearch = Nothing
Set rng_Found = Nothing
On Error GoTo 0

Exit Sub

ErrorHandler:

MsgBox "Error in updating users: " & Err.Number & vbCrLf & Err.Description

Resume ExitPoint

End Sub

Answer 2

到目前为止，这是我的代码

Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As msforms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As msforms.fmDragState, Effect As msforms.fmDropEffect, ByVal Shift As Integer)

End Sub

Private Sub ClsFrmE_Click()
Unload Me
End Sub





Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("workers")




'???÷? ?? ?????? ?????
If Trim(Me.cmbWN.Value) = "" Then
  Me.cmbWN.SetFocus
  MsgBox "???? ?? ????"
  Exit Sub
End If

If Trim(Me.tbDate.Value) = "" Then
  Me.tbDate.SetFocus
  MsgBox "???? ????? ?????"
  Exit Sub
End If


'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected
With ws
'  .Unprotect Password:="password"
  If Trim(Me.dNdcmb.Value) = "????" Then
  .Cells(lRow, 6).Value = 1
  Else
  .Cells(lRow, 6).Value = 0
  End If
  .Cells(lRow, 7).Value = Me.tbDate.Value
  '.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
'  .Protect Password:="password"
End With

'clear the data
Me.cmbWN.Value = ""
Me.tbDate.Value = ""

Me.cmbWN.SetFocus

ActiveWorkbook.Save
End Sub
Private Sub UserForm_Initialize()
Dim cFullName As Range
Dim cDnd As Range

Dim ws As Worksheet
Set ws = Worksheets("workers")

For Each cFullName In ws.Range("??????")
  With Me.cmbWN
    .AddItem cFullName.Value
    .List(.ListCount - 1, 1) = cFullName.Offset(0, 1).Value
  End With
Next cFullName

For Each cDnd In ws.Range("??????????")
  With Me.dNdcmb
    .AddItem cDnd.Value

  End With
Next cDnd
Me.dNdcmb.Text = Me.dNdcmb.List(Me.dNdcmb.ListCount - 2)
Me.cmbWN.SetFocus
End Sub

Answer 3

我创建了一个模块并添加了这个：

Option Explicit
Public Sub update_sheet(workername As String)
'--> If the user was selected on the form update column F to Yes
    Dim ws As Worksheet
    Dim rowno As Long

    Set ws = Sheets("workers")

    With ws
        rowno = .Range("C:C").Find(workername).Row
        .Cells(rowno, 6).Value = "Yes"
    End With
End Sub

在表单代码上：

Private Sub cb_select_change()
    Call update_sheet(cb_select.Value)
End Sub

你的组合框在哪里被调用cb_select