您想了解我如何从Excel工作表中检索数据并在用户表单中进行更新。
在图片上,您可以看到用户形态的样子。 我想做的是创建另一个用户表单,可以在工作表中搜索特定的引用并更新该特定行的一些单元格。
Private Sub cmdClear_Click()
' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub cmdSend_Click()
Dim RowCount As Long
Dim ctl As Control
' Check user input
If Me.combTechnieker.Value = "" Then
MsgBox "Dag vreemdeling! Welke van de 4 Mongolen ben je?", vbExclamation, "RMA invoer"
Me.combTechnieker.SetFocus
Exit Sub
End If
If Me.txtPcwRef.Value = "" Then
MsgBox "Vul onze referentie in!", vbExclamation, "RMA invoer"
Me.txtPcwRef.SetFocus
Exit Sub
End If
If Me.txtKlant.Value = "" Then
MsgBox "Vul de naam van de klant in!", vbExclamation, "RMA invoer"
Me.txtKlant.SetFocus
Exit Sub
End If
If Me.txtMerk.Value = "" Then
MsgBox "Vul het merk in!", vbExclamation, "RMA invoer"
Me.txtMerk.SetFocus
Exit Sub
End If
If Me.txtMerkRef.Value = "" Then
MsgBox "Vul de referentie van de fabrikant in!", vbExclamation, "RMA invoer"
Me.txtMerkRef.SetFocus
Exit Sub
End If
If Me.txtProduct.Value = "" Then
MsgBox "Vul het product in!", vbExclamation, "RMA invoer"
Me.txtProduct.SetFocus
Exit Sub
End If
If Me.txtSerienummer.Value = "" Then
MsgBox "Vul het serienummer in!", vbExclamation, "RMA invoer"
Me.txtSerienummer.SetFocus
Exit Sub
End If
If Me.txtProbleem.Value = "" Then
MsgBox "Vul de probleem omschrijving in!", vbExclamation, "RMA invoer"
Me.txtProbleem.SetFocus
Exit Sub
End If
If Me.txtOnderdelen.Value = "" Then
MsgBox "Bent u zeker dat er geen onderdelen achterblijven. Indien ja. Vul N/A in", vbExclamation, "RMA invoer"
Me.txtOnderdelen.SetFocus
Exit Sub
End If
' Write data to worksheet
RowCount = Worksheets("RMA 2016").Range("A1").CurrentRegion.Rows.Count
With Worksheets("RMA 2016").Range("A1")
.Offset(RowCount, 0).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(RowCount, 1).Value = "Open"
.Offset(RowCount, 3).Value = Me.txtPcwRef.Value
.Offset(RowCount, 4).Value = Me.txtKlant.Value
.Offset(RowCount, 5).Value = Me.txtMerk.Value
.Offset(RowCount, 6).Value = Me.txtMerkRef.Value
.Offset(RowCount, 7).Value = Me.txtProduct.Value
.Offset(RowCount, 8).Value = Me.txtSerienummer.Value
.Offset(RowCount, 9).Value = Me.txtOnderdelen.Value
.Offset(RowCount, 10).Value = Me.txtProbleem.Value
.Offset(RowCount, 13).Value = Me.combTechnieker.Value
If Me.chkGarantie.Value = True Then
.Offset(RowCount, 2).Value = "Ja"
Else
.Offset(RowCount, 2).Value = "Nee"
End If
End With
' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub UserForm_Click()
End Sub
答案 0 :(得分:1)
我创建了一个小例子来展示加载,保存和删除记录的一般机制如何与表单一起工作。当您尝试使用不存在的ID保存记录时,它会向表中追加一条新记录。这应该非常接近您的要求,并向您展示如何在用户表单和工作表之间随机播放数据。
Private Sub cmdLoad_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to load the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' product ID is not found
MsgBox "Product ID " & Me.txtId & " doesn't exist."
Exit Sub
Else
' product ID is found -- fill out the form
Me.txtId = rngId.Offset(0, 0)
Me.txtName = rngId.Offset(0, 1)
Me.txtNote = rngId.Offset(0, 2)
End If
End Sub
Private Sub cmdSave_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to load the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' if product ID is not found, append new one to the end of the table
With rngIdList
Set rngId = .Offset(.Rows.Count, 0).Resize(1, 1)
End With
End If
' update excel record
rngId.Offset(0, 0) = Me.txtId
rngId.Offset(0, 1) = Me.txtName
rngId.Offset(0, 2) = Me.txtNote
End Sub
Private Sub cmdDelete_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to delete the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' product ID is not found -- nothing to delete
MsgBox "Product ID " & Me.txtId & " doesn't exist."
Exit Sub
Else
' product ID is found -- delete the entire line
rngId.EntireRow.Delete
End If
End Sub
答案 1 :(得分:0)
这是一个解释如何执行此操作的链接。
http://www.onlinepclearning.com/edit-and-delete-from-a-userform/
您基本上需要使用高级过滤器录制宏,该过滤器根据您想要的任何条件过滤数据。然后,该数据可用于使用动态名称范围为用户表单中的列表框提供数据,此时也会复制过滤后的数据。然后,您可以编写一些代码,允许它在双击时在userform中提供空文本框。然后使用一个使用excel的'find'功能的录制宏,它可以找到更新的条目(如果它有一个唯一的ID)并用新的值替换旧的值。
提供的链接将逐步完成此步骤。您只需要修改以适合您的工作簿。
希望这有帮助!
我做过的项目示例:
'this is my recorded filter
Sub FilterData()
'
' FilterData Macro
'
'
Sheets("Propert Data").Range("A6:M80").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Sheet2!Criteria"), CopyToRange:=Range( _
"Sheet2!Extract"), Unique:=False
End Sub
'This feeds the listbox
Dim ws As Worksheet
'Set Worksheet Variable
Set ws = Sheet2
'Run Filter
FilterLoans 'this is a recorded macro
'Add named range to rowsource
If ws.Range("A5").Value = "" Then
Me.loanlist.RowSource = ""
Else
Me.loanlist.RowSource = "FilterLoans" 'this is a dynamic name range
End If
'This feeds the empty cells
Private Sub loanlist_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Integer
On Error Resume Next
i = Me.loanlist.ListIndex
Me.edloannametxt.Value = Me.loanlist.Column(0, i)
Me.edpropnametxt.Value = Me.loanlist.Column(1, i)
Me.edloantypecbx.Value = Me.loanlist.Column(2, i)
Me.edbalancetxt.Value = Me.loanlist.Column(3, i)
Me.edbalancetxt.Value = Format(Val(edbalancetxt.Value), "$#,###")
Me.edpmttxt.Value = Me.loanlist.Column(4, i)
Me.edpmttxt.Value = Format(Val(edpmttxt.Value), "$#,###")
Me.edannualtxt.Value = Me.loanlist.Column(5, i)
Me.edannualtxt.Value = Format(Val(edannualtxt.Value), "$#,###")
Me.edratetxt.Value = Me.loanlist.Column(6, i)
Me.edratetxt.Value = Format(Val(edratetxt.Value), "Percent")
Me.edamtxt.Value = Me.loanlist.Column(7, i)
Me.edbbtcbx.Value = Me.loanlist.Column(8, i)
Me.uidtxt.Value = Me.loanlist.Column(9, i)
End Sub
'this finds and updates that old data
Private Sub updateloancmd_Click()
Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet
Application.ScreenUpdating = False
Set DataSH = Sheet10
Set findvalue = DataSH.Range("K:K"). _
Find(What:=Me.uidtxt.Value, LookIn:=xlValues, LookAt:=xlWhole)
findvalue = uidtxt.Value
If findvalue = "" Then
Exit Sub
Else
findvalue.Offset(0, -1) = edbbtcbx.Value
findvalue.Offset(0, -2) = edamtxt.Value
findvalue.Offset(0, -3) = edratetxt.Value
findvalue.Offset(0, -5) = edpmttxt.Value
findvalue.Offset(0, -6) = edbalancetxt.Value
findvalue.Offset(0, -7) = edloantypecbx.Value
findvalue.Offset(0, -8) = edpropnametxt.Value
findvalue.Offset(0, -9) = edloannametxt.Value
End If
End Sub