以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  品牌如何按“助记码”产生的数字规律自动递增编号?  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=9515)

--  作者:明丰
--  发布时间:2011/4/19 15:25:00
--  品牌如何按“助记码”产生的数字规律自动递增编号?
 

功能:第2列输入品牌(汉字、数字、英文),第1列自动生成4位数字+2位顺序号。
编号规则:1 品牌为汉字的,取第一二个汉字拼音助记码转换为数字,如
            “
其它助记码为“QT”,字母对应的数字为35 31
            
A=15 B=52 C=54 D=13 E=33 F=12 G=11 H=21 I=43 J=22
K=23 L=24 M=25 N=51 O=44 P=45 Q=35 R=32 S=14 T=31
U=42 V=53 W=34 X=55 Y=41 Z=26
此为五笔字根所在键位)
自动生成编号:35 31 0101为顺序号,自动递增)
          2
品牌为英文的,取第一二个字母转换即可
          3
品牌为数字的,取第一二三四数字即可,不足后面补0(如“3M 3 25 0

按数字规律自动递增顺序号:

  “天骄”312201

  “天杰”312202

  “添美”312501(不是312503

  “特美”312502

  “3M3250013 25 0 01


--  作者:狐狸爸爸
--  发布时间:2011/4/19 15:55:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目60.table


--  作者:blackzhu
--  发布时间:2011/4/19 16:27:00
--  
简单
--  作者:明丰
--  发布时间:2011/4/24 10:26:00
--  
先谢过了,另有一个问题:品牌列设置了禁止重复,但如果用复制的方法还是可以保存的,该怎样设置才不会出现这种情况?另当品牌单元格清除内容以后,编号不会随之清空。
--  作者:狐狸爸爸
--  发布时间:2011/4/24 14:32:00
--  

关于禁止重复内容,看这段帮助的示例四:
 
http://help.foxtable.com/topics/0624.htm


 
要清除编号,可以改一下代码:
 
If e.DataCol.Name  = "品牌" Then
    If e.NewValue > ""  Then
        Dim s1 As String = GetPy(e.NewValue,True)
        Dim s2 As String
        Dim cs() As String = New String() {"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"}
        Dim ns() As String = new String(){15,52,54,13,33,12,11,21,43,22,23,24,25,51,44,45,35,32,14,31,42,53,34,55,41,26}
        For i As Integer = 0 To s1.length -1
            Dim s3 As String = s1.Chars(i)
            If Char.IsNumber(s3)  = False Then
                For n As Integer =0 To cs.Length -1
                    If cs(n) = s3 Then
                        s3 = ns(n)
                        Exit For
                    End If
                Next
            End If
            s2 = s2 & s3
        Next
        s2 = s2.PadRight(4,"0")
        s2 = s2.SubString(0,4)
        Dim drs As List(of DataRow) = e.DataTable.Select("编号 Like \'" & s2 & "*\' And [_Identify] < " & e.DataRow("_Identify"))
        If drs.Count = 0
           e.DataRow("编号") = s2 & "01"
        Else
           e.DataRow("编号") = s2 & Format(drs.count + 1,"00")
        End If
    Else
        e.DataRow("编号") = Nothing
    End If
End If


--  作者:明丰
--  发布时间:2011/4/24 15:04:00
--  
多谢了!
--  作者:明丰
--  发布时间:2011/4/25 23:34:00
--  

如果不单独建立“品牌资料表”,而是在增加货品资料时,“品牌”直接在货品资料中录入,能否这样设置:当“品牌”有重复值时,跳转到该品牌最末条记录所在行,并提示“该品牌已有N条记录,是否复制当前行,是、否”;否则提示“该品牌资料未记录”并自动新增品牌编号。请帮忙写下代码。谢谢!

 


--  作者:狐狸爸爸
--  发布时间:2011/4/26 7:52:00
--  
看不到图,选择图片文件后,是需要上传的。
--  作者:blackzhu
--  发布时间:2011/4/26 8:24:00
--  
你看看这样行不?

If e.DataCol.Name  = "品牌" Then
    Dim dr As DataRow
    Dim Filter As String
    dr = DataTables("表A").Find("品牌 = \'" &e.newValue & "\'")
    If dr IsNot Nothing Then \'如果找到的话
        Tables("表A").Filter = "品牌 = \'" & e.NewValue & "\'"
        Dim r As Integer = CurrentTable.Rows.Count
        Dim Result As DialogResult
        Result = MessageBox.Show("表里相同的品牌记录" & "\'" & e.NewValue  & "\'" & "共有" & r & "条,是否复制当前行", "提示",MessageBoxButtons.YesNo, MessageBoxIcon.Question)
        If Result = DialogResult.Yes Then
            Dim dr1 As DataRow = e.DataTable.DataRows(e.DataTable.DataRows.Count - 1) \'获得最后一行
            For Each dc As DataCol In e.DataTable.DataCols
                e.DataRow(dc.Name) = dr(dc.Name) \'将最后一行的内容复制到新增行中.
            Next
        Else
            MessageBox.Show("此品牌没有记录!")
            Tables("表A").AddNew()
            \'If e.DataCol.Name  = "品牌" Then
            If e.NewValue > ""  Then
                Dim s1 As String = GetPy(e.NewValue,True)
                Dim s2 As String
                Dim cs() As String = New String() {"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"}
                Dim ns() As String = new String(){15,52,54,13,33,12,11,21,43,22,23,24,25,51,44,45,35,32,14,31,42,53,34,55,41,26}
                For i As Integer = 0 To s1.length -1
                    Dim s3 As String = s1.Chars(i)
                    If Char.IsNumber(s3)  = False Then
                        For n As Integer =0 To cs.Length -1
                            If cs(n) = s3 Then
                                s3 = ns(n)
                                Exit For
                            End If
                        Next
                    End If
                    s2 = s2 & s3
                Next
                s2 = s2.PadRight(4,"0")
                s2 = s2.SubString(0,4)
                Dim drs As List(of DataRow) = e.DataTable.Select("编号 Like \'" & s2 & "*\' And [_Identify] < " & e.DataRow("_Identify"))
                If drs.Count = 0
                    e.DataRow("编号") = s2 & "01"
                Else
                    e.DataRow("编号") = s2 & Format(drs.count + 1,"00")
                End If
            Else
                e.DataRow("编号") = Nothing
            End If
        End If
    End If
End If

--  作者:blackzhu
--  发布时间:2011/4/26 8:26:00
--  
If e.DataCol.Name  = "品牌" Then
    Dim dr As DataRow
    Dim Filter As String
    dr = DataTables("表A").Find("品牌 = \'" &e.newValue & "\'")
    If dr IsNot Nothing Then \'如果找到的话
        Tables("表A").Filter = "品牌 = \'" & e.NewValue & "\'"
        Dim r As Integer = CurrentTable.Rows.Count
        Dim Result As DialogResult
        Result = MessageBox.Show("表里相同的品牌记录" & "\'" & e.NewValue  & "\'" & "共有" & r & "条,是否复制当前行", "提示",MessageBoxButtons.YesNo, MessageBoxIcon.Question)
        If Result = DialogResult.Yes Then
            Dim dr1 As DataRow = e.DataTable.DataRows(e.DataTable.DataRows.Count - 1) \'获得最后一行
            For Each dc As DataCol In e.DataTable.DataCols
                e.DataRow(dc.Name) = dr(dc.Name) \'将最后一行的内容复制到新增行中.
            Next
        Else
            MessageBox.Show("此品牌没有记录!")
            Tables("表A").AddNew()
       end if
            If e.DataCol.Name  = "品牌" Then
            If e.NewValue > ""  Then
                Dim s1 As String = GetPy(e.NewValue,True)
                Dim s2 As String
                Dim cs() As String = New String() {"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"}
                Dim ns() As String = new String(){15,52,54,13,33,12,11,21,43,22,23,24,25,51,44,45,35,32,14,31,42,53,34,55,41,26}
                For i As Integer = 0 To s1.length -1
                    Dim s3 As String = s1.Chars(i)
                    If Char.IsNumber(s3)  = False Then
                        For n As Integer =0 To cs.Length -1
                            If cs(n) = s3 Then
                                s3 = ns(n)
                                Exit For
                            End If
                        Next
                    End If
                    s2 = s2 & s3
                Next
                s2 = s2.PadRight(4,"0")
                s2 = s2.SubString(0,4)
                Dim drs As List(of DataRow) = e.DataTable.Select("编号 Like \'" & s2 & "*\' And [_Identify] < " & e.DataRow("_Identify"))
                If drs.Count = 0
                    e.DataRow("编号") = s2 & "01"
                Else
                    e.DataRow("编号") = s2 & Format(drs.count + 1,"00")
                End If
            Else
                e.DataRow("编号") = Nothing
            End If
        End If
    End If
重发一下,修改了一下