Foxtable(狐表)用户栏目专家坐堂 → 英文转数字代码问题


  共有4006人关注过本帖树形打印复制链接

主题:英文转数字代码问题

帅哥哟,离线,有人找我吗?
hongye
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
英文转数字代码问题  发帖心情 Post By:2022/5/6 13:27:00 [只看该作者]

Dim cmd As New SQLCommand
Dim dt2 As DataTable
cmd.C
cmd.CommandText = "SELECT * Fro m {英文数字对照表}"
dt2 = cmd.ExecuteReader(True)
Dim sss As String = "LavenderBlush08"
Dim ktx As String
If Char.IsLetter(sss(0)) Then
    ktx = "1"
Else
    ktx = "0" 
End If 
Dim pss As String
Dim dss As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
For i As Integer = 0 To Len(sss) - 1
    Dim sdr As DataRow
    If Char.IsLetter(sss(i)) = True Or Char.IsDigit(sss(i)) = True Then 
        If Char.IsLetter(sss(i)) Then
            sdr = dt2.Find("[英文字母] = '" & sss(i) & "'")
            s1 = "这是一个字母!"
            s3 = sdr("代码")
        Else
            s1 = "这不是一个字母!"
            s3 = sss(i)
        End If
    End If
    s2 = s2 & s3
Next
Dim zz As String 
If Len(s2) < 7 Then
    zz = ktx & s2.PadLeft(7, "0")
ElseIf Len(s2) > 7 Then
    zz = ktx & s2.Remove(7)
End If 
Output.Show(s1 & "  " & s3 & "  " & zz)
感觉代码太长,看看是否能改短点呢?

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107034 积分:544401 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/6 13:43:00 [只看该作者]

举例说明一下,要做什么功能?

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/7 0:21:00 [只看该作者]


图片点击可在新窗口打开查看此主题相关图片如下:02.jpg
图片点击可在新窗口打开查看


Dim cmd As New SQLCommand
Dim dt As DataTable
Dim dt1 As DataTable
Dim dt2 As DataTable
Dim dt3 As DataTable
cmd.C
cmd.CommandText = "SELECT * Fr om {面料订单明细}"
dt = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * F rom {颜色对照表}"
dt1 = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * Fr om {英文数字对照表}"
dt2 = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * Fr om {面料信息}"
dt3 = cmd.ExecuteReader(True)
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog 
dlg.Filter = "Excel文件|*.xlsx|Excel文件|*.xls" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Dim dtb As New DataTableBuilder("订单")
    For n As Integer = 0 To Sheet.cols.Count - 1
        If Sheet(0, n).Value <> "" Then
            dtb.AddDef(Sheet(0, n).Value, GetType(String), 255)
        End If
    Next
    dtb.Build()
    Dim tb As Table = Tables("订单")
    For n As Integer = 1 To Sheet.Rows.Count - 1
        Dim r As Row = tb.AddNew()
        For m As Integer = 0 To tb.cols.Count - 1
            r(tb.Cols(m).Name) = Sheet(n, m).Value
        Next
        Tables("订单").ResumeRedraw()
    Next
    Dim Vals As List(Of String())
    Vals = DataTables("订单").GetValues("物料色号|物料色名", "", "物料色号")
    For i As Integer = 0 To Vals.Count - 1
        Dim sgdr As DataRow
        sgdr = dt1.Find("色号 = '" & Vals(i)(0) & "' And 颜色 = '" & Vals(i)(1) & "'")
        If sgdr IsNot Nothing Then
            e.Cancel = True
        Else
            Dim shm As String = Vals(i)(0)
            Dim ysm As String = Vals(i)(1)
            Dim tst As String
            Dim zm As String
            If Char.IsLetter(shm(0)) Then
                zm = "1"
            Else
                zm = "0" 
            End If 
            Dim s2 As String
            Dim s3 As String
            For i1 As Integer = 0 To Len(shm) - 1
                Dim sdr As DataRow
                If Char.IsLetter(shm(i1)) = True Or Char.IsDigit(shm(i1)) = True Then 
                    If Char.IsLetter(shm(i1)) Then
                        sdr = dt2.Find("[英文字母] = '" & shm(i1) & "'")
                        s3 = sdr("代码")
                    Else
                        s3 = shm(i1)
                    End If
                End If
                s2 = s2 & s3
            Next
            Dim zz As String 
            If Len(s2) < 7 Then
                zz = zm & s2.PadLeft(7, "0")
            ElseIf Len(s2) > 7 Then
                zz = zm & s2.Remove(2, Len(s2) - 7)
            End If 
            Dim max As String
            Dim idx As Integer
            max = dt1.Compute("Max(代码)", "色号 = '" & shm & "' And 颜色 = '" & ysm & "' And Len(代码) = 10")
            If max > "" Then '如果存在最大编号
                idx = CInt(max) + 1 '获得最大编号的后三位顺序号,并加1
            Else
                idx = 1 '否则顺序号等于1
            End If
            Dim dr As DataRow = dt1.AddNew()
            dr("色号") = Vals(i)(0)
            dr("颜色") = Vals(i)(1)
            dr("代码") = zz & Format(idx, "00")
        End If
    Next
    Dim Cols1() As String = {"物料编号", "物料色号", "品牌", "大货款号", "明细件数", "合计数量/kg", "要求成品截止时间", "实际大货毛衣工厂", "面料收货地址" }
    Dim Cols2() As String = {"客户编号", "色号", "品牌", "款号", "件数", "数量", "交货日期", "交货单位", "备注" }
    For Each dr1 As DataRow In DataTables("订单").DataRows
        Dim Filter As String = "[客户编号] = '" & dr1("物料编号").Trim(" ", "-") & "' And [色号] = '" & dr1("物料色号") & "' And [款号] = '" & dr1("大货款号") & "' And [数量] = '" & dr1("合计数量/kg") & "' And [交货日期] = '" & dr1("要求成品截止时间") & "'"
        Dim fzdr As DataRow
        fzdr = dt.Find(Filter)
        If fzdr IsNot Nothing Then
            e.Cancel = True
        Else
            Dim dr2 As DataRow = dt.AddNew()
            For i As Integer = 0 To Cols1.Length - 1
                If dr1("物料编号").Contains("-") = True Then
                    dr2("客户编号") = dr1("物料编号").Trim(" ", "-")
                    Dim mdr As DataRow
                    mdr = dt3.Find("[客户编号] = '" & dr2("客户编号") & "'")
                    dr2("面料名称") = mdr("面料名称")
                    dr2("面料门幅") = mdr("门幅")
                    dr2("面料克重") = mdr("克重")
                    If dr2("色号") <> "" Then
                        Dim ydr As DataRow
                        ydr = dt1.Find("[色号] = '" & dr2("色号") & "'")
                        dr2("颜色") = ydr("颜色")
                        dr2("面料识别号") = mdr("面料编号") & ydr("代码")
                    End If
                End If
                dr2(Cols2(i)) = dr1(Cols1(i))
            Next
        End If
    Next
End If
If dt1.HasChanges Then
    dt1.save()
    dt1.Load
End If
If dt.HasChanges Then
    dt.save()
    dt.Load
    DataTables("窗口3_Table1").Load
End If

不知道哪出问题了

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/7 0:21:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:面料系统.rar


 回到顶部
帅哥,在线噢!
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107034 积分:544401 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/7 9:01:00 [只看该作者]

调试技巧:http://www.foxtable.com/webhelp/scr/1485.htm,看哪一句代码出错

 回到顶部
帅哥,在线噢!
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107034 积分:544401 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/7 9:01:00 [只看该作者]

有几个地方没有判断find的结果

                       sdr = dt2.Find("[英文字母] = '" & shm(i1) & "'")
                        s3 = sdr("代码")

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/7 10:27:00 [只看该作者]

Dim cmd As New SQLCommand
Dim dt As DataTable
Dim dt1 As DataTable
Dim dt2 As DataTable
Dim dt3 As DataTable
cmd.C
cmd.CommandText = "SELECT * Fro m {面料订单明细}"
dt = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * Fr om {颜色对照表}"
dt1 = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * Fr om {英文数字对照表}"
dt2 = cmd.ExecuteReader(True)
cmd.CommandText = "SELECT * Fro m {面料信息}"
dt3 = cmd.ExecuteReader(True)
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog 
dlg.Filter = "Excel文件|*.xlsx|Excel文件|*.xls" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Dim dtb As New DataTableBuilder("订单")
    For n As Integer = 0 To Sheet.cols.Count - 1
        If Sheet(0, n).Value <> "" Then
            dtb.AddDef(Sheet(0, n).Value, GetType(String), 255)
        End If
    Next
    dtb.Build()
    Dim tb As Table = Tables("订单")
    For n As Integer = 1 To Sheet.Rows.Count - 1
        Dim r As Row = tb.AddNew()
        For m As Integer = 0 To tb.cols.Count - 1
            r(tb.Cols(m).Name) = Sheet(n, m).Value
        Next
        Tables("订单").ResumeRedraw()
    Next
    Dim Vals As List(Of String())
    Vals = DataTables("订单").GetValues("物料色号|物料色名", "", "物料色号")
    For i As Integer = 0 To Vals.Count - 1
        Dim sgdr As DataRow
        sgdr = dt1.Find("色号 = '" & Vals(i)(0) & "' And 颜色 = '" & Vals(i)(1) & "'")
        If sgdr IsNot Nothing Then
            e.Cancel = True
        Else
            Dim shm As String = Vals(i)(0)
            Dim ysm As String = Vals(i)(1)
            Dim tst As String
            Dim zm As String
            If Char.IsLetter(shm(0)) Then
                zm = "1"
            Else
                zm = "0" 
            End If 
            Dim s2 As String = ""
            For i1 As Integer = 0 To Len(shm) - 1
                Dim s3 As String = ""
                Dim sdr As DataRow
                If Char.IsLetter(shm(i1)) = True Or Char.IsDigit(shm(i1)) = True Then  
                    sdr = dt2.Find("[英文字母] = '" & shm(i1) & "'")
                    If Char.IsLetter(shm(i1)) Then
                            s3 = sdr("代码")
                    Else
                            s3 = shm(i1) 
                    End If
                End If
                s2 = s2 & s3
            Next
            Dim zz As String 
            If Len(s2) < 7 Then
                zz = zm & s2.PadLeft(7, "0")
            ElseIf Len(s2) > 7 Then
                zz = zm & s2.Remove(2, Len(s2) - 7)
            End If 
            Dim max As String
            Dim idx As Integer
            max = dt1.Compute("Max(代码)", "色号 = '" & shm & "' And 颜色 = '" & ysm & "' And Len(代码) = 10")
            If max > "" Then '如果存在最大编号
                idx = CInt(max) + 1 '获得最大编号的后三位顺序号,并加1
            Else
                idx = 1 '否则顺序号等于1
            End If
            Dim dr As DataRow = dt1.AddNew()
            dr("色号") = Vals(i)(0)
            dr("颜色") = Vals(i)(1)
            dr("代码") = zz & Format(idx, "00")
        End If
    Next
    Dim Cols1() As String = {"物料编号", "物料色号", "品牌", "大货款号", "明细件数", "合计数量/kg", "要求成品截止时间", "实际大货毛衣工厂", "面料收货地址" }
    Dim Cols2() As String = {"客户编号", "色号", "品牌", "款号", "件数", "数量", "交货日期", "交货单位", "备注" }
    For Each dr1 As DataRow In DataTables("订单").DataRows
        Dim Filter As String = "[客户编号] = '" & dr1("物料编号").Trim(" ", "-") & "' And [色号] = '" & dr1("物料色号") & "' And [款号] = '" & dr1("大货款号") & "' And [数量] = '" & dr1("合计数量/kg") & "' And [交货日期] = '" & dr1("要求成品截止时间") & "'"
        Dim fzdr As DataRow
        fzdr = dt.Find(Filter)
        If fzdr IsNot Nothing Then
            e.Cancel = True
        Else
            Dim dr2 As DataRow = dt.AddNew()
            For i As Integer = 0 To Cols1.Length - 1
                If dr1("物料编号").Contains("-") = True Then
                    dr2("客户编号") = dr1("物料编号").Trim(" ", "-")
                    Dim mdr As DataRow
                    mdr = dt3.Find("[客户编号] = '" & dr2("客户编号") & "'")
                    dr2("面料名称") = mdr("面料名称")
                    dr2("面料门幅") = mdr("门幅")
                    dr2("面料克重") = mdr("克重")
                    If dr2("色号") <> "" Then
                        Dim ydr As DataRow
                        ydr = dt1.Find("[色号] = '" & dr2("色号") & "'")
                        dr2("颜色") = ydr("颜色")
                        dr2("面料识别号") = mdr("面料编号") & ydr("代码")
                    End If
                End If
                dr2(Cols2(i)) = dr1(Cols1(i))
            Next
        End If
    Next
End If
    If dt1.HasChanges Then
        dt1.save()
        dt1.Load
    End If
If dt.HasChanges Then
    dt.save()
    dt.Load
    DataTables("窗口3_Table1").Load
End If

调试了兜一圈没问题,但是到保存前就会出错,能帮我改改吗?
问题应该在红色部分,我注释了红色部分了,运行没问题
[此贴子已经被作者于2022/5/7 10:40:02编辑过]

 回到顶部
帅哥,在线噢!
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107034 积分:544401 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/7 10:43:00 [只看该作者]

还是6楼的问题:还有代码没有判断find的结果

极端一点,每一行代码后都加调试语句,我就不信找不到出错的代码是哪一句

Dim cmd As New SQLCommand
msgbox(1)
Dim dt As DataTable
msgbox(2)
Dim dt1 As DataTable
msgbox(3)
Dim dt2 As DataTable
msgbox(4)
……

再说了,都说是find的问题,就不会搜索一下代码里find在什么地方吗?!!

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/7 10:58:00 [只看该作者]

我再试试,不行再求助

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2943 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/7 11:50:00 [只看该作者]

代码自身好像没问题,是数据库的问题,但是如何让它提示,并且不弹出错误信息呢

 回到顶部
总数 12 1 2 下一页