以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  请老师看代码能精简吗?  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=128978)

--  作者:Liangcai
--  发布时间:2018/12/19 13:05:00
--  请老师看代码能精简吗?

请老师帮我看一下,下面代码能精简吗,请指教,谢谢!

Dim t As Table = e.Form.controls("Table1").Table
Dim ary() As String = Functions.Execute("Xueqi")
If e.Sender.Value IsNot Nothing Then
    Dim dlg As New OpenFileDialog
    dlg.Filter = "Excel文件|*.xls;*.xlsx"
    If dlg.ShowDialog =DialogResult.OK Then
        t.StopRedraw()
        Dim Book As New XLS.Book(dlg.FileName)
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Dim newcount As Integer = 0
        Dim oldcount As Integer = 0
        If e.Sender.text = "学生基本信息" Then
            SQL = "IIF(Len(身份证号) =18,IIF(MID(身份证号,17,1) Mod 2,\'男\',\'女\'),Null)"
            t.Fill("Sel ect  学生编号,学生姓名,身份证号," & SQL & " As 性别,int(datediff(\'d\',IIF(Len(身份证号) =18,MID(身份证号,7,4) & \'-\' & MID(身份证号,11,2) & \'-\' & MID(身份证号,13,2)),Cdate(cstr(year(Date()))+\'-09-01\'))/365.2422) As 年龄,\'\' As 序号,学籍号,民族,入学年份,父亲姓名,母亲姓名,父亲电话,母亲电话,父亲社保,母亲社保,监护人姓名,支付宝账号,户籍省,户籍县,户籍镇,暂住街道,暂住社区,暂住门牌号 From {学生基本信息} Where IIF(Right(\'"& ary(1) &"\',1) = \'1\',Year(Date()) - 入学年份+1,IIF(Right(\'"& ary(1) &"\',1) = \'2\',Year(Date()) - 入学年份)) < 9","数据库",True)
            t.Filter = "学生编号 Is Null"
            For n As Integer = 2 To Sheet.Rows.Count -1
                Dim r As DataRow = t.DataTable.Find("身份证号 = \'" & sheet(n, 1).text & "\'")
                If r Is Nothing Then
                    r = t.DataTable.AddNew()
                    Dim max As String = t.DataTable.Compute("Max(学生编号)","学生编号 Like \'" & ary(2) & "%\'")
                    If max = "" Then
                        r("学生编号") = ary(2) & "001"
                    Else
                        Dim v As Integer = max.SubString(6,3)
                        r("学生编号") = ary(2) & format(v +1,"000")
                    End If
                    r("性别") = ReadSex(sheet(n, 1).text)
                    r("年龄") = int((CDate(cstr(Date.Today.Year)+"-09-01") - CDate(ReadBirthday(sheet(n, 1).text))).TotalDays / 365.2422)
                    r("序号") = "1"
                    newcount += 1
                Else
                    r("序号") = "2"
                    oldcount += 1
                End If
                For i As Integer = 0 To sheet.Cols.Count -1
                    Dim cname As String = sheet(0, i).text
                    If t.Cols.Contains(cname) Then
                        r(cname) = sheet(n, i).Text
                    End If
                Next
            Next
            msgbox("新增" & newcount & "    " & "更新旧数据" & oldcount)
            t.ResumeRedraw()
        Else If e.Sender.text= "缴学费信息" Then
            SQL = "Se lect  学期,班级,a.学生编号,学生姓名,身份证号,\'\' As 序号,缴费日期,缴费金额,收款人 From {学生基本信息} a Inner JOIN {缴学费} b ON a.学生编号 = b.学生编号 Where 学期 = \'"& ary(1) &"\' ORDER BY 班级,a.学生编号"
            t.Fill(SQL,"数据库",True)
            t.Filter = "学生编号 Is Null"
            For n As Integer = 2 To Sheet.Rows.Count -1
                Dim r As DataRow = t.DataTable.Find("身份证号 = \'" & sheet(n, 2).text & "\'")
                If r Is Nothing Then
                    r = t.DataTable.AddNew()
                    dr = DataTables("学生基本信息").SQLFind("身份证号 = \'" & sheet(n, 2).text & "\'")
                    If dr Is Nothing Then
                        Dim max As String = DataTables("学生基本信息").SQLCompute("Max(学生编号)","学生编号 Like \'" & ary(2) & "%\'")
                        If max = "" Then
                            r("学生编号") = ary(2) & "001"
                        Else
                            Dim v As Integer = max.SubString(6,3)
                            r("学生编号") = ary(2) & format(v +1,"000")
                        End If
                    Else
                        r("学生编号") = dr("学生编号")
                    End If
                    r("序号") = "1"
                    newcount += 1
                Else
                    r("序号") = "2"
                    oldcount += 1
                End If
                r("学期") = IIF(Right(ary(1),1) ="1",ary(1).Remove(4)& "年秋季",ary(1).Remove(4)& "年春季")
                For i As Integer = 0 To sheet.Cols.Count -1
                    Dim cname As String = sheet(0, i).text
                    If t.Cols.Contains(cname) Then
                        r(cname) = sheet(n, i).Text
                    End If
                Next
            Next
            msgbox("新增" & newcount & "    " & "更新旧数据" & oldcount)
            t.ResumeRedraw()
        Else If e.Sender.text = "缴餐费信息" Then
            SQL = "Sel ect  学期,\'\' As 班级,a.学生编号,学生姓名,身份证号,\'\' As 序号,缴费日期,缴费金额,收款人 From {学生基本信息} a Inner JOIN {缴餐费} b ON a.学生编号 = b.学生编号 Where 学期 = \'"& ary(1) &"\' ORDER BY a.学生编号"
            t.Fill(SQL,"数据库",True)
            t.Filter = "学生编号 Is Null"
            For n As Integer = 2 To Sheet.Rows.Count -1
                Dim r As DataRow = t.DataTable.Find("身份证号 = \'" & sheet(n, 2).text & "\'")
                If r Is Nothing Then
                    r = t.DataTable.AddNew()
                    dr = DataTables("学生基本信息").SQLFind("身份证号 = \'" & sheet(n, 2).text & "\'")
                    If dr IsNot Nothing Then
                        r("学生编号") = dr("学生编号")
                    End If
                    r("序号") = "1"
                    newcount += 1
                Else
                    r("序号") = "2"
                    oldcount += 1
                End If
                r("学期") = IIF(Right(ary(1),1) ="1",ary(1).Remove(4)& "年秋季",ary(1).Remove(4)& "年春季")
                For i As Integer = 0 To sheet.Cols.Count -1
                    Dim cname As String = sheet(0, i).text
                    If t.Cols.Contains(cname) Then
                        r(cname) = sheet(n, i).Text
                    End If
                Next
            Next
            msgbox("新增" & newcount & "    " & "更新旧数据" & oldcount)
            t.ResumeRedraw()
        Else  If e.Sender.text = "缴车费信息" Then
            SQL = "Sele ct  学期,\'\' As 班级,a.学生编号,学生姓名,身份证号,\'\' As 序号,缴费日期,缴费金额,接送地点,收款人 From {学生基本信息} a Inner JOIN {缴车费} b ON a.学生编号 = b.学生编号 Where 学期 = \'"& ary(1) &"\' ORDER BY a.学生编号"
            t.Fill(SQL,"数据库",True)
            t.Filter = "学生编号 Is Null"
            For n As Integer = 2 To Sheet.Rows.Count -1
                Dim r As DataRow = t.DataTable.Find("身份证号 = \'" & sheet(n, 2).text & "\'")
                If r Is Nothing Then
                    dr = DataTables("学生基本信息").SQLFind("身份证号 = \'" & sheet(n, 2).text & "\'")
                    If dr IsNot Nothing Then
                        r = t.DataTable.AddNew()
                        r("学生编号") = dr("学生编号")
                    End If
                    r("序号") = "1"
                    newcount += 1
                Else
                    r("序号") = "2"
                    oldcount += 1
                End If
                r("学期") = IIF(Right(ary(1),1) ="1",ary(1).Remove(4)& "年秋季",ary(1).Remove(4)& "年春季")
                For i As Integer = 0 To sheet.Cols.Count -1
                    Dim cname As String = sheet(0, i).text
                    If t.Cols.Contains(cname) Then
                        r(cname) = sheet(n, i).Text
                    End If
                Next
            Next
            msgbox("新增" & newcount & "    " & "更新旧数据" & oldcount)
            t.ResumeRedraw()
        End If
    End If
    t.Filter = "序号 = \'1\' Or  序号 = \'2\'"

[此贴子已经被作者于2018/12/19 13:13:58编辑过]

--  作者:有点甜
--  发布时间:2018/12/19 14:46:00
--  

 

不建议精简,各个表的导入方式尽量分开处理,不然你某个excel表格结构修改、或者foxtable表格修改、或者你填入的数据修改了,就不能只修改那个表的代码了。

 


--  作者:Liangcai
--  发布时间:2018/12/19 15:46:00
--  

谢谢老师