[已解决]号码递增，覆盖不递增，新的单号显示是之前递增那个单号

hrq145

Sub Addxiaoshoubaocun() Dim i As Integer, j As Integer, k As Integer, iRows As Integer, n As Integer Dim mydata As String, SQL As String, myTable As String, myFieldList() As Variant Dim cnn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim r%, l%, sq1, fin mydata = ThisWorkbook.Path & "\新兴特种纸数据库.mdb" myTable = "销售资料" ' On Error GoTo ErrorHandler If Range("C2") = "" Then MsgBox "请填写销售类型": Exit Sub If Range("b3") = "" Then MsgBox "请填写客户": Exit Sub If Range("f16") = "" Then MsgBox "请填应付款金额": Exit Sub Application.ScreenUpdating = True For r = 5 To 14 Sheets("销售单").Range("g" & r) = Range("e" & r) * Range("f" & r) If Sheets("销售单").Range("b" & r) <> "" Then iRows = iRows + 1 Next If iRows = 0 Then MsgBox "请填写数据后再保存": Exit Sub Call xsgongshi With cnn   .Provider = "microsoft.jet.oledb.4.0"   .Open mydata End With sq1 = "Select * from 销售资料  where 单据编号='" & Sheets("销售单").Range("h3").Value & "'"     rs.Open sq1, cnn, adOpenKeyset, adLockOptimistic 'rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic     If rs.RecordCount > 0 Then              If MsgBox("你确定要覆盖 " & Sheets("销售单").Range("h3").Value & " 的资料吗 ?", vbYesNo, "Update the existing data") = vbNo Then                 Exit Sub                 Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")                 Else                      cnn.Execute ("delete from 销售资料 where 单据编号='" & Sheets("销售单").Range("h3").Value & "'")             For i = 5 To iRows + 4               rs.AddNew               rs.Fields("销售类型") = Sheets("销售单").Range("c2")               rs.Fields("客户") = Sheets("销售单").Range("b3")               rs.Fields("录入日期") = Sheets("销售单").Range("d3")               rs.Fields("单据编号") = Sheets("销售单").Range("h3")               For j = 1 To 9                 rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value                   Next j                 rs.Fields("货款状态") = Sheets("销售单").Range("b16")                  rs.Fields("应付金额") = Sheets("销售单").Range("f16")                   rs.Update             Next i             End If        Else                      For i = 5 To iRows + 4               rs.AddNew               rs.Fields("销售类型") = Sheets("销售单").Range("c2")               rs.Fields("客户") = Sheets("销售单").Range("b3")               rs.Fields("录入日期") = Sheets("销售单").Range("d3")               rs.Fields("单据编号") = Sheets("销售单").Range("h3")               For j = 1 To 9                 rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value                   Next j                 rs.Fields("货款状态") = Sheets("销售单").Range("b16")                  rs.Fields("应付金额") = Sheets("销售单").Range("f16")                   rs.Update             Next i             End If     rs.UpdateBatch rs.Close cnn.Close Set cnn = Nothing: Set rs = Nothing Sheet1.CommandButton1.Visible = True 'ErrorHandler: '    MsgBox Err.Number & vbCrLf & _ '           Err.Description     If Range("c2") = "销售单" Then      Range("z1") = Range("z1") + 1     Else      Range("aa1") = Range("aa1") + 1     End If     'Sheet1.Range("b5:j14,b3:c3,j3,c16,g16:j16,e3:g3").ClearContents     Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")     Sheets("销售单").Range("c2") = "销售单"     Application.ScreenUpdating = True     MsgBox "数据写入数据库完毕！", vbOKOnly + vbInformation End Sub 这个代码单号就会自动递增，内容有的话覆盖下去还是递增，  我需要单号覆盖了不用递增，显示开单的最后一个单号，保存后才要递增

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-5-17 22:42

1. Sub Addxiaoshoubaocun()
   
2.     Dim i As Integer, j As Integer, k As Integer, iRows As Integer, n As Integer
   
3.     Dim mydata As String, SQL As String, myTable As String, myFieldList() As Variant
   
4.     Dim blOver As Boolean
   
5.     Dim cnn As New ADODB.Connection
   
6.     Dim rs As New ADODB.Recordset
   
7.     Dim r%, l%, sq1, fin
   
8.     mydata = ThisWorkbook.Path & "\新兴特种纸数据库.mdb"
   
9.     myTable = "销售资料"
   
10.     ' On Error GoTo ErrorHandler
    
11.     If Range("C2") = "" Then MsgBox "请填写销售类型": Exit Sub
    
12.     If Range("b3") = "" Then MsgBox "请填写客户": Exit Sub
    
13.     If Range("f16") = "" Then MsgBox "请填应付款金额": Exit Sub
    
14.     Application.ScreenUpdating = True
    
15.     For r = 5 To 14
    
16.         Sheets("销售单").Range("g" & r) = Range("e" & r) * Range("f" & r)
    
17.         If Sheets("销售单").Range("b" & r) <> "" Then iRows = iRows + 1
    
18.     Next
    
19.     If iRows = 0 Then MsgBox "请填写数据后再保存": Exit Sub
    
20.     Call xsgongshi
    
21. 
    
22.     With cnn
    
23.         .Provider = "microsoft.jet.oledb.4.0"
    
24.         .Open mydata
    
25.     End With
    
26.     sq1 = "Select * from 销售资料  where 单据编号='" & Sheets("销售单").Range("h3").Value & "'"
    
27.     rs.Open sq1, cnn, adOpenKeyset, adLockOptimistic
    
28.     'rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic
    
29.     If rs.RecordCount > 0 Then
    
30.         If MsgBox("你确定要覆盖 " & Sheets("销售单").Range("h3").Value & " 的资料吗 ?", vbYesNo, "Update the existing data") = vbNo Then
    
31.             Exit Sub
    
32.             Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")
    
33.         Else
    
34.             cnn.Execute ("delete from 销售资料 where 单据编号='" & Sheets("销售单").Range("h3").Value & "'")
    
35.             For i = 5 To iRows + 4
    
36.                 rs.AddNew
    
37.                 rs.Fields("销售类型") = Sheets("销售单").Range("c2")
    
38.                 rs.Fields("客户") = Sheets("销售单").Range("b3")
    
39.                 rs.Fields("录入日期") = Sheets("销售单").Range("d3")
    
40.                 rs.Fields("单据编号") = Sheets("销售单").Range("h3")
    
41.                 For j = 1 To 9
    
42.                     rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value
    
43.                 Next j
    
44.                 rs.Fields("货款状态") = Sheets("销售单").Range("b16")
    
45.                 rs.Fields("应付金额") = Sheets("销售单").Range("f16")
    
46.                 rs.Update
    
47.             Next i
    
48.             blOver = True
    
49.         End If
    
50.     Else
    
51. 
    
52.         For i = 5 To iRows + 4
    
53.             rs.AddNew
    
54.             rs.Fields("销售类型") = Sheets("销售单").Range("c2")
    
55.             rs.Fields("客户") = Sheets("销售单").Range("b3")
    
56.             rs.Fields("录入日期") = Sheets("销售单").Range("d3")
    
57.             rs.Fields("单据编号") = Sheets("销售单").Range("h3")
    
58.             For j = 1 To 9
    
59.                 rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value
    
60. 
    
61.             Next j
    
62.             rs.Fields("货款状态") = Sheets("销售单").Range("b16")
    
63.             rs.Fields("应付金额") = Sheets("销售单").Range("f16")
    
64.             rs.Update
    
65.         Next i
    
66.     End If
    
67. 
    
68.     rs.UpdateBatch
    
69.     rs.Close
    
70.     cnn.Close
    
71.     Set cnn = Nothing: Set rs = Nothing
    
72.     Sheet1.CommandButton1.Visible = True
    
73.     'ErrorHandler:
    
74.     '    MsgBox Err.Number & vbCrLf & _
    
75.          '           Err.Description
    
76.     If Range("c2") = "销售单" Then
    
77.         If Not blOver Then Range("z1") = Range("z1") + 1
    
78.     Else
    
79.         If Not blOver Then Range("aa1") = Range("aa1") + 1
    
80.     End If
    
81.     'Sheet1.Range("b5:j14,b3:c3,j3,c16,g16:j16,e3:g3").ClearContents
    
82.     Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")
    
83.     Sheets("销售单").Range("c2") = "销售单"
    
84.     Application.ScreenUpdating = True
    
85.     MsgBox "数据写入数据库完毕！", vbOKOnly + vbInformation
    
86. End Sub

复制代码

我这没法测试，楼主自己试试吧。

跳转到最佳答案楼层

hwc2ycy

1. Sub Addxiaoshoubaocun()
   
2.     Dim i As Integer, j As Integer, k As Integer, iRows As Integer, n As Integer
   
3.     Dim mydata As String, SQL As String, myTable As String, myFieldList() As Variant
   
4.     Dim blOver As Boolean
   
5.     Dim cnn As New ADODB.Connection
   
6.     Dim rs As New ADODB.Recordset
   
7.     Dim r%, l%, sq1, fin
   
8.     mydata = ThisWorkbook.Path & "\新兴特种纸数据库.mdb"
   
9.     myTable = "销售资料"
   
10.     ' On Error GoTo ErrorHandler
    
11.     If Range("C2") = "" Then MsgBox "请填写销售类型": Exit Sub
    
12.     If Range("b3") = "" Then MsgBox "请填写客户": Exit Sub
    
13.     If Range("f16") = "" Then MsgBox "请填应付款金额": Exit Sub
    
14.     Application.ScreenUpdating = True
    
15.     For r = 5 To 14
    
16.         Sheets("销售单").Range("g" & r) = Range("e" & r) * Range("f" & r)
    
17.         If Sheets("销售单").Range("b" & r) <> "" Then iRows = iRows + 1
    
18.     Next
    
19.     If iRows = 0 Then MsgBox "请填写数据后再保存": Exit Sub
    
20.     Call xsgongshi
    
21. 
    
22.     With cnn
    
23.         .Provider = "microsoft.jet.oledb.4.0"
    
24.         .Open mydata
    
25.     End With
    
26.     sq1 = "Select * from 销售资料  where 单据编号='" & Sheets("销售单").Range("h3").Value & "'"
    
27.     rs.Open sq1, cnn, adOpenKeyset, adLockOptimistic
    
28.     'rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic
    
29.     If rs.RecordCount > 0 Then
    
30.         If MsgBox("你确定要覆盖 " & Sheets("销售单").Range("h3").Value & " 的资料吗 ?", vbYesNo, "Update the existing data") = vbNo Then
    
31.             Exit Sub
    
32.             Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")
    
33.         Else
    
34.             cnn.Execute ("delete from 销售资料 where 单据编号='" & Sheets("销售单").Range("h3").Value & "'")
    
35.             For i = 5 To iRows + 4
    
36.                 rs.AddNew
    
37.                 rs.Fields("销售类型") = Sheets("销售单").Range("c2")
    
38.                 rs.Fields("客户") = Sheets("销售单").Range("b3")
    
39.                 rs.Fields("录入日期") = Sheets("销售单").Range("d3")
    
40.                 rs.Fields("单据编号") = Sheets("销售单").Range("h3")
    
41.                 For j = 1 To 9
    
42.                     rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value
    
43.                 Next j
    
44.                 rs.Fields("货款状态") = Sheets("销售单").Range("b16")
    
45.                 rs.Fields("应付金额") = Sheets("销售单").Range("f16")
    
46.                 rs.Update
    
47.             Next i
    
48.             blOver = True
    
49.         End If
    
50.     Else
    
51. 
    
52.         For i = 5 To iRows + 4
    
53.             rs.AddNew
    
54.             rs.Fields("销售类型") = Sheets("销售单").Range("c2")
    
55.             rs.Fields("客户") = Sheets("销售单").Range("b3")
    
56.             rs.Fields("录入日期") = Sheets("销售单").Range("d3")
    
57.             rs.Fields("单据编号") = Sheets("销售单").Range("h3")
    
58.             For j = 1 To 9
    
59.                 rs.Fields(j + 4) = Sheets("销售单").Cells(i, j).Value
    
60. 
    
61.             Next j
    
62.             rs.Fields("货款状态") = Sheets("销售单").Range("b16")
    
63.             rs.Fields("应付金额") = Sheets("销售单").Range("f16")
    
64.             rs.Update
    
65.         Next i
    
66.     End If
    
67. 
    
68.     rs.UpdateBatch
    
69.     rs.Close
    
70.     cnn.Close
    
71.     Set cnn = Nothing: Set rs = Nothing
    
72.     Sheet1.CommandButton1.Visible = True
    
73.     'ErrorHandler:
    
74.     '    MsgBox Err.Number & vbCrLf & _
    
75.          '           Err.Description
    
76.     If Range("c2") = "销售单" Then
    
77.         If Not blOver Then Range("z1") = Range("z1") + 1
    
78.     Else
    
79.         If Not blOver Then Range("aa1") = Range("aa1") + 1
    
80.     End If
    
81.     'Sheet1.Range("b5:j14,b3:c3,j3,c16,g16:j16,e3:g3").ClearContents
    
82.     Sheets("销售单").Range("h3") = "XSD" & Format(Date, "yymm") & Format(Range("z1"), "00000")
    
83.     Sheets("销售单").Range("c2") = "销售单"
    
84.     Application.ScreenUpdating = True
    
85.     MsgBox "数据写入数据库完毕！", vbOKOnly + vbInformation
    
86. End Sub

复制代码

我这没法测试，楼主自己试试吧。

su45

这么长的代码，看着头疼…………