请求改写删除代码

zsd5237 · 发表于 2011-10-7 21:15

附件中有查询代码和清空表单的代码，很好用。但想删除ACC数据库的数据时，虽学了一位老师的代码（见模块1删除单条数据），但只能删除单条记录，不能删除一个以同一编号的记录集，如数据库中同一编号的数据行有很多条（最多七条），如要删除相同编号的多行数据，这个代码不能实现，请老师傅修改一下这个代码。

mxg825 · 发表于 2011-10-7 21:15

Sub 删除单条数据() '删除数据
Dim a
Dim RS1 As Recordset
Dim DB1 As Database
a = MsgBox("是否确定删除编号为" & Sheet9.Range("K4").Value & "这条记录", vbInformation + vbOKCancel, "提醒")
If a = vbOK Then
Set DB1 = OpenDatabase(ThisWorkbook.Path & "\产品出入库数据库.MDB")
Set RS1 = DB1.OpenRecordset(Name:="出入库数据表", Type:=dbOpenDynaset)
RS1.FindFirst "编号='" & Sheet9.Range("K4").Value & "'"
If RS1.NoMatch = True Then
RS1.Close
Set RS1 = Nothing '空值
Set DB1 = Nothing
MsgBox "没有相关记录", vbInformation, "提醒"
Else
Do'MXG825修改了。。。。。。。
RS1.Delete
RS1.FindNext "编号='" & Sheet9.Range("K4").Value & "'"
Loop Until RS1.NoMatch = True‘MXG825 10月7日。。。。。。
RS1.Close '结束
MsgBox "删除了" & Sheet9.Range("K4").Value & "记录"
清空
Set RS1 = Nothing
Set DB1 = Nothing
Exit Sub
End If
End If
End Sub

复制代码

zsd5237 · 发表于 2011-10-9 05:47

本帖最后由 zsd5237 于 2011-10-9 06:07 编辑

谢谢，我太笨了，MXG825只修改了二句代码即OK了，再次谢谢。不知金币是否已送出？另外下面一段代码是修改代码，可以用。但有一个问题：如果是修改ACC数据库的第一个编号的数据时，属这个编号的第一行数据（也是数据库的第一行数据）不修改，但修改第二个编号数据时，代码执行正常，我不知问题出在何处，请老师指导修整（可用本贴一楼附件测试）：Sub 修改()
Dim i As Long
Dim j As Long
Dim x As Long
Dim y As Long
Dim T, t1
Dim db1 As Database '声明数据库变量
Dim RS1 As Recordset '声明指针

T = Timer
Set db1 = OpenDatabase(ThisWorkbook.Path & "\产品出入库数据库.mdb")
Set RS1 = db1.OpenRecordset(Name:="出入库数据表", Type:=dbOpenDynaset)

For x = 6 To 12
      If Sheet9.Cells(x, 2) <> "" Then
         y = y + 1
      End If
Next x '新记录条数
Do
      RS1.FindNext "编号='" & Sheet9.Range("K4").Value & "'"
      i = i + 1
Loop Until RS1.NoMatch = True
If y <> i - 1 Then
      MsgBox "表单的数据行数与原数据库内的行数不一致不能修改！"
      RS1.Close '结束
      db1.Close
      Exit Sub
Else
      With RS1
         .MoveFirst '将记录指针移至第一条

         For i = 6 To 12
            If Sheet9.Cells(i, 2) <> "" Then
                  .FindNext "编号='" & Sheet9.Range("K4") & "'"
                  .Edit '编辑修改

                  .Fields("客户部门编码") = Sheet9.Range("B4").Value
                  .Fields("客户部门名称") = Sheet9.Range("C4").Value
                  .Fields("日期") = Sheet9.Range("I4").Value
                  .Fields("编号") = Sheet9.Range("K4").Value
                  .Fields("出入库单号") = Sheet9.Range("M4").Value
                  .Fields("出入库类型编码") = Sheet9.Range("N4").Value
                  .Fields("出入库类型名称") = Sheet9.Range("O4").Value
                  .Fields("单据类型") = Sheet9.Range("E2").Value
                  .Fields("地址") = Sheet9.Range("D4").Value
                  .Fields("企业性质") = Sheet9.Range("E4").Value
                  .Fields("大区负责人") = Sheet9.Range("F4").Value
                  .Fields("分区负责人") = Sheet9.Range("G4").Value
                  .Fields("业务员") = Sheet9.Range("H4").Value
                  .Fields("录入员姓名") = Sheet9.Range("F13").Value
                  .Fields("复核员姓名") = Sheet9.Range("D13").Value

                  .Fields("产品编码") = Sheet9.Cells(i, 2)
                  .Fields("产品名称") = Sheet9.Cells(i, 3)
                  .Fields("规格") = Sheet9.Cells(i, 4)
                  .Fields("计量单位") = Sheet9.Cells(i, 5)
                  .Fields("单价") = Sheet9.Cells(i, 6)
                  .Fields("成本单价") = Sheet9.Cells(i, 7)
                  .Fields("入库包数") = Sheet9.Cells(i, 8)
                  .Fields("入库数量") = Sheet9.Cells(i, 9)
                  .Fields("入库成本") = Sheet9.Cells(i, 10)
                  .Fields("出库包数") = Sheet9.Cells(i, 11)
                  .Fields("其中送包数") = Sheet9.Cells(i, 12)
                  .Fields("出库数量") = Sheet9.Cells(i, 13)
                  .Fields("销售金额") = Sheet9.Cells(i, 14)
                  .Fields("出库成本") = Sheet9.Cells(i, 15)
                  RS1.Update '把记录保存到数据库
            End If
         Next i
      End With

      MsgBox "数据修改成功"
End If
t1 = Timer - T ' 计算总时间
RS1.Close
db1.Close
End Sub

		自动登录	找回密码
密码			注册

请求改写删除代码

最佳答案