以文本方式查看主题 - Foxtable(狐表) (http://foxtable.com/bbs/index.asp) -- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2) ---- 英文转数字代码问题 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=177005) |
||||
-- 作者:hongye -- 发布时间: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) 感觉代码太长,看看是否能改短点呢?
|
||||
-- 作者:有点蓝 -- 发布时间:2022/5/6 13:43:00 -- 举例说明一下,要做什么功能? |
||||
-- 作者:hongye -- 发布时间: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 -- 发布时间:2022/5/7 0:21:00 --
|
||||
-- 作者:有点蓝 -- 发布时间:2022/5/7 9:01:00 -- 调试技巧:http://www.foxtable.com/webhelp/scr/1485.htm,看哪一句代码出错 |
||||
-- 作者:有点蓝 -- 发布时间:2022/5/7 9:01:00 -- 有几个地方没有判断find的结果 sdr = dt2.Find("[英文字母] = \'" & shm(i1) & "\'") s3 = sdr("代码") |
||||
-- 作者:hongye -- 发布时间: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编辑过]
|
||||
-- 作者:有点蓝 -- 发布时间: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 -- 发布时间:2022/5/7 10:58:00 -- 我再试试,不行再求助 |
||||
-- 作者:hongye -- 发布时间:2022/5/7 11:50:00 -- 代码自身好像没问题,是数据库的问题,但是如何让它提示,并且不弹出错误信息呢 |