自动编号的问题

gzkrmch

我从论坛里找了个代码,这是自动编号比较好的一个代码,但现在有个问题,我不想要中间的"-",如:CG-20120817-0001
如果把"-"去了又不能编号了,请问怎么才能不显示"-":如CG201208170001

原来的结果CG-20120817-0001
想要的结果CG201208170001

Dim a, c, JP, JPRQ As String
    Dim b, bh As Long
    c = Format([WXRQ], "yyyymmdd")
    JP = Me.CJJP
   
    JPRQ = JP & c
    bh = Val(Nz(Right(DMax("WXDH", "WXCLDA查询", "Left([WXDH],InStr([WXDH],'-')-1) &  (Left(Right([WXDH],13),8)) = '" & JPRQ & "'"), 3))) + 1
    If JP <> a Then
        Me.WXDH = JP & "-" & c & "-" & Format(bh, "0000")
    Else
        Me.WXDH =JP & "-" & c & "-" & "0001"
    End If

因为我对代码不熟,折腾两天了,出不了结果{:soso_e127:} 只能求助大家了{:soso_e183:}


纠正一下我的最后一个问题,执行此事件时,先判断"Me.WXDH"字段如有数据时就不再写入,这前面的代码应怎么写{:soso_e113:}

ynjxw

        Me.WXDH = JP &  c & Format(bh, "0000")
    Else
        Me.WXDH =JP &  c &  "0001"

ynjxw

if len(nz(Me.WXDH))=0 then
执行你的代码
end if

gzkrmch

ynjxw 发表于 2012-8-17 16:59
Me.WXDH = JP &  c & Format(bh, "0000")
    Else
        Me.WXDH =JP &  c &  "0001"

这样我试过了,只能生成第一个单号,第二个单号就不能生成了

gzkrmch

ynjxw 发表于 2012-8-17 17:00
if len(nz(Me.WXDH))=0 then
执行你的代码
end if

谢谢您的代码,
我是这样想的,因为第一次执行事件时,单号已经生成了一个,当我重新更改字段时,又执行了代码,此时单号又改变了,会生成新的单号,我想再改此段时,如果"ME.WXDH"里有数据的话,就不再执行以下单号的代码,单号还是以前的那个,不再生成新的单号,那判断"ME.WXDH"有数据时不执行下面的代码,怎么写呢,

layaman_999

效率不高的编号函数，只要结果，不考虑性能

gzkrmch

layaman_999 发表于 2012-8-17 23:05
效率不高的编号函数，只要结果，不考虑性能

那怎样写才能提高性能

andymark

建议用表保存当前的编号，需要的时候直接从表里提取该值就OK了

思路参考6楼示例 ：高效的年月日的自动编号函数
http://www.office-cn.net/thread-114014-1-1.html

gzkrmch

andymark 发表于 2012-8-19 19:36
建议用表保存当前的编号，需要的时候直接从表里提取该值就OK了

思路参考6楼示例 ：高效的年月日的自动编 ...

但是有个问题,表里生成的单号只能是一个,我的是要按不同类别生成的,比台前面用CG.或BJ.或其它不同的类别简拼字母生成新的单号比如,CG201208210001是一个,BJ201208210001也是一个,但都在同一表里,如果用此代码的话,好像实现不了此种编号,并且我的单号每天排序不会超过500个,所以先不用考虑效率,先考虑实用性

牧野白狼

Private Function TestConnect() As String     On Error GoTo Err_TestConnect      Dim strConnect As String     Dim Conn As Object    ' New ADODB.Connection      If Nz(Me.txtServer) = "" Or Nz(Me.txtDatabase) = "" Then         MyMsgBox "=86", vbCritical          '未指定数据库。         Exit Function     End If     strConnect = "rovider=SQLOLEDB" & _                  ";Data Source=" & Me.txtServer & _                  ";Initial Catalog=" & Me.txtDatabase & _                  ";User ID=" & Nz(Me.txtUserName) & _                  "assword=" & Nz(Me.txtPassword)          Me.lblTip.Caption = "Connect to the network database," & _                         "due to the need to search the database server in the network," & _                         "the pogram may temporarily lose response,please be patient."     '    Me.lblTip.Caption = "连接网络数据库时，由于需要在网络中搜索数据库服务器，" & _          "程序可能会暂时失去响应，请耐心等待。"     Me.Repaint     Set Conn = CreateObject("ADODB.Connection")     Conn.ConnectionString = strConnect     Conn.ConnectionTimeout = 30     Conn.CommandTimeout = 30     Conn.Open     Conn.Close      TestConnect = "ODBC" & _                   ";DRIVER=SQL Server" & _                   ";SERVER=" & Me.txtServer & _                   ";DATABASE=" & Me.txtDatabase & _                   ";UID=" & Me.txtUserName & _                   "WD=" & Me.txtPassword Exit_TestConnect:     Me.lblTip.Caption = ""     Exit Function  Err_TestConnect:     TestConnect = ""     '忽略取消操作错误     If Err <> 3059 Then MsgBox "#" & Err & vbCrLf & Err.Description, vbCritical     Resume Exit_TestConnect End Function把“-”改成“”