Excel VBA 用户表单，更新和删除数据库，

Question

我是 Excel VBA 的新手，我已经通过 whosebug.com 找到了大部分问题的解决方案，但仍然有一个问题我无法解决. 我正在使用多维用户表单来维护我们的数据库。我正在处理的用户窗体包含选项框、复选框、文本框和组合框。经过长时间的搜索和工作，我修复了搜索底部，它们都在工作。但是我无法使更新底部和删除底部正常工作。我已经上传了文件，如果有人能帮我解决这个问题，我将不胜感激。

Private Sub bt2_Click() 'Update shipment
Dim sonsat As Long, sor As String
If ListBox1.ListIndex = -1 Then
MsgBox "Choose an item", vbExclamation, ""
Exit Sub
End If

sor = MsgBox("Are your sure?", vbYesNo, "")
If sor = vbNo Then Exit Sub

lastrow = Sheets("logbook").Cells(Rows.count, 1).End(xlUp).Row
Sheets("logbook").Range("A1:A" & lastrow).Find(What:=ListBox1.Value, 
LookIn:=xlValues, LookAt:=xlWhole).Activate
sonsat = ActiveCell.Row
Cells(sonsat, 1) = op1
Cells(sonsat, 2) = op2
Cells(sonsat, 3) = chb1
Cells(sonsat, 4) = chb2
Cells(sonsat, 5) = tb14
Cells(sonsat, 6) = tb1
Cells(sonsat, 7) = tb2
Cells(sonsat, 8) = tb3
Cells(sonsat, 9) = tb4
Cells(sonsat, 10) = tb5
Cells(sonsat, 11) = cb1
Cells(sonsat, 12) = tb6
Cells(sonsat, 13) = tb7
Cells(sonsat, 14) = tb8
Cells(sonsat, 15) = tb9
Cells(sonsat, 16) = cb2
Cells(sonsat, 17) = tb10
Cells(sonsat, 18) = tb11
Cells(sonsat, 19) = tb12
Cells(sonsat, 20) = cb3
Cells(sonsat, 21) = cb4
Cells(sonsat, 22) = tb13


MsgBox "Item Has Been Changed", vbInformation, ""
ListBox1.list = Sheets("logbook").Range("A1:V" & 
Sheets("logbook").Cells(Rows.count, 1).End(xlUp).Row).Value

If Me.op1.Value = True Then
Cells(sonsat, 1).Value = "X"
Else
Cells(sonsat, 1).Value = "-"
End If

If Me.op2.Value = True Then
Cells(sonsat, 2).Value = "X"
Else
Cells(sonsat, 2).Value = "-"
End If

If Me.chb1.Value = True Then
Cells(sonsat, 3).Value = "X"
Else
Cells(sonsat, 3).Value = "-"
End If

If Me.chb2.Value = True Then
Cells(sonsat, 4) = "X"
Else
Cells(sonsat, 4) = "-"
End If
End Sub



Private Sub bt3_Click() 'delete shipmet
Dim sil As Long
Dim e, b, c, d As Integer


If ListBox1.ListIndex = -1 Then
MsgBox "Choose an entry", vbExclamation, ""
Exit Sub
End If

If ListBox1.ListIndex >= 0 Then
cevap = MsgBox("Entry will be deleted. ... Are you sure ?", vbYesNo, "")
If cevap = vbYes Then
Sheets("logbook").Range("A:A").Find(What:=ListBox1.Value).Activate
sil = ActiveCell.Row
Sheets("logbook").Rows(sil).Delete
End If
End If

For d = 1 To 2
Controls("op" & d) = False
Next

For c = 1 To 4
Controls("cb" & c) = "-"
Next

For b = 1 To 2
Controls("chb" & b) = False
Next

For e = 1 To 14
Controls("tb" & e) = ""
Next

ListBox1.list = Sheets("logbook").Range("A1:V" & 
Sheets("logbook").Cells(Rows.count, 1).End(xlUp).Row).Value
End Sub

Answer 1

以下内容基于您上传到 Google 云端硬盘的文件（截至 2017 年 6 月 8 日，09:01 英国时间）。

我在尝试打开工作簿时丢失了一些控件，也许我们的 Excel 版本差异太大，我无法处理它们。这些是您的日期控件 dtp2 和 dtp3。每当它们给我带来麻烦时，我都会注释掉与它们相关的代码。希望这不会对接下来的内容产生负面影响...

主要建议

为了完全达到运行，我必须声明 lastrow 变量和 cevap 变量。
您的 listbox1 允许 multi-select。如果只想更新一行，则需要确保只选择了一行。在控件属性的 "Behaviour" 部分，我将 MultiSelect 更改为 0 - fmMultiSelectSingle。
因为您允许 multi-select，所以 listbox1.value 不起作用。当您允许 multi-select（请参阅 here）时，您必须以不同的方式执行此操作。但假设您对 single-select 没意见，则无需担心。
当您使用 Find ... Activate 时，您会得到一个不同的错误。 Excel 无法 Activate 电子表格，因为 Userform1 保留焦点。您也许可以通过制作 "non-modal" 形式来更改它，但我不会。相反，而不是，例如：
```
Sheets("logbook").Range("A1:A" & lastrow).Find(What:=ListBox1.Value, _
   LookIn:=xlValues, LookAt:=xlWhole).Activate
sonsat = ActiveCell.Row
```
我愿意
```
sonsat = Sheets("logbook").Range("A1:A" & 
   lastrow).Find(What:=ListBox1.Value, _
LookIn:=xlValues, LookAt:=xlWhole).Row
```
这避免了 Activate 的需要。之后的代码应该运行没有抱怨。
然而，它仍然没有如你所愿。列表框的值基于您的绑定列，您已将其设置为第一列。该值不唯一标识该行。结果，当您运行 update/delete 代码时 updates/deletes 第一个匹配行。

小事

目前没有任何东西阻止用户选择 updating/deleting header 行。就个人而言，我会将它们从列表框中取出（从 A2 而不是 A1 开始）并将它们作为 "column headings" 添加到表单中。
我猜表格的标题应该是 "Data Entry Application" 而不是 "Data Entery Application".

Excel VBA 用户表单，更新和删除数据库，

Excel VBA Userform, Update and delete database,

excel

vba

userform