出库单自动编号代码修改

925977828

点击出库单的“新单”按钮后出库单内容清空出库单编号自动+1  出库单的格式是固定码“SC”+年份“2018”（根据系统时间变化）+月份"06"(根据系统时间变化)+流水号0000开始（流水号每次点击“新单”自动+1，），列如：SC2018060001，SC2018060002.......SC2018070020，SC2018070021......SC2019010001(月份变化流水号还是累加，不根据月份变化从新排号，跨年以后流水号又从0001开始)。
现在这个代码，累加到0002，后面就不+1了。望哪位师傅帮忙修改下，谢谢
以下是代码1
Private Sub CommandButton2_Click() '新单
On Error Resume Next '
Dim r%, i%
Application.ScreenUpdating = False
Set rg = Sheets("汇总表").[c65536].End(3)
    [i3] = 生成编号

代码2
Private Function 生成编号() As String
On Error Resume Next '
    Dim theYear$, theMonth$
    Dim theCell As Range, theFirstAddress$, theStrMaxNumNow$, theStrNum$
    theYear = Year(Date): theMonth = Format(Month(Date), "00"):
    theStrNum = "SC" & theYear & theMonth
    theStrMaxNumNow = "0000"
    With ThisWorkbook.Worksheets("汇总表").Columns(3)
        Set theCell = .Cells.Find(what:=theStrNum, after:=.Cells(.Count), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
        If Not theCell Is Nothing Then
            theFirstAddress = theCell.Address
            Do
                If Right(theCell, 3) > theStrMaxNumNow Then theStrMaxNumNow = Right(theCell, 2)
                Set theCell = .FindNext(theCell)
            Loop Until theCell.Address = theFirstAddress
        End If
    End With
    生成编号 = "SC" & theYear & theMonth & Format(CVar(theStrMaxNumNow) + 1, "0000")
End Function

925977828

朱荣兴 发表于 2018-6-17 14:36
请上传你的excel附件

这个是表格，谢谢

yaojil

附件里面代码有待楼主多学习VBA优化精简一下，看着就累
弃用原来的 ‘生成编号’ 自定义函数，测试一下吧

1. Private Sub CommandButton2_Click() '新单
   
2. On Error Resume Next '
   
3. Dim r%, i%
   
4. Application.ScreenUpdating = False
   
5.    Sheets("送货单").[i4] = Format(Date, "yyyy/m/d")
   
6. If Sheets("汇总表").[c65536].End(3).Row < 2 Then
   
7.    Sheets("送货单").[i3] = "SC" & Format(Date, "yyyymm") & "0001"
   
8. Else
   
9.    If Val(Right(Sheets("汇总表").[c65536].End(3), 4)) = Val(Right(Sheets("送货单").[i3], 4)) Then
   
10.       Sheets("送货单").[i3] = "SC" & Format(Date, "yyyymm") & Format(Val(Right(Sheets("送货单").[i3], 4)) + 1, "0000")
    
11.    End If
    
12. End If
    
13. 
    
14. With Sheets("送货单")
    
15.      For i = 6 To 100
    
16.          If InStr(.Range("A" & i), "金额合计") Then    'If .Range("A" & i) = "金额合计(大写):" Then
    
17.             r = i - 1
    
18.             Exit For
    
19.         End If
    
20.      Next
    
21.      .Range("b3:b4") = ""
    
22.      .Range("A6:J" & r).ClearContents
    
23.      If r > 13 Then
    
24.         .Rows("14:" & r).Delete   '设置为标准表格，保留8行数据行
    
25.      End If
    
26.      'With .Range("I6:I13")
    
27.      '     '.Font.Name = "宋体"
    
28.      '     '.Font.Size = 10
    
29.      '     '.HorizontalAlignment = xlRight
    
30.      '     .FormulaR1C1 = "=RC[-2]*RC[-1]"
    
31.      'End With
    
32.      .Range("I6").FormulaR1C1 = "=RC[-2]*RC[-1]"
    
33.      .Range(Cells(6, 9), Cells(13, 9)).FillDown      '向下填充公式
    
34.      .Cells(14, 7).Formula = "=sum(r6c:r[-1]c)"
    
35.      .Cells(14, 9).Formula = "=sum(r6c:r[-1]c)"
    
36. End With
    
37. CommandButton3.Enabled = True
    
38. Application.ScreenUpdating = True
    
39. End Sub

复制代码

925977828

yaojil 发表于 2018-6-19 08:15
附件里面代码有待楼主多学习VBA优化精简一下，看着就累
弃用原来的 ‘生成编号’ 自定义函数，测试一下吧
...

谢谢，好用，非常感谢

925977828

yaojil 发表于 2018-6-19 08:15
附件里面代码有待楼主多学习VBA优化精简一下，看着就累
弃用原来的 ‘生成编号’ 自定义函数，测试一下吧
...

能再帮忙改下数据有效性填充的格式吗，原版是选择B3，填充B4客户地址，改成选择B3，填充E3(联系人）和E4（联系电话），附件在楼上谢谢，刚刚开始学，太难了还是找你们帮忙吧，附件也是论坛里找了自己修改的，还是不理想。望给予帮助，能优化下里面的代码更好，非常谢谢