Foxtable(狐表) → 用户栏目 → 专家坐堂 → 运行有点慢，能不能帮我改进一下呢


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

主题：运行有点慢，能不能帮我改进一下呢
帅哥哟，离线，有人找我吗？
hongye
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：一尾狐 帖子：437 积分：2943 威望：0 精华：0 注册：2011/3/15 12:49:00 		运行有点慢，能不能帮我改进一下呢  发帖心情 Post By：2020/4/6 23:08:00 [只看该作者]

Dim fr As String
fr = e.Form.name & "_"
Dim kh As WinForm.Label = e.Form.Controls("客户")
Dim kd As WinForm.Label = e.Form.Controls("客户担当")
Dim pm As WinForm.Label = e.Form.Controls("品名")
Dim ks As WinForm.Label = e.Form.Controls("款号")
Dim kss As String = ks.Text
kss = kss.Trim
Dim yk As WinForm.Label = e.Form.Controls("样衣款号")
Dim yks As String = yk.Text
yks = yks.Trim
Dim lb As WinForm.Label = e.Form.Controls("类别")
Dim jh As WinForm.Label = e.Form.Controls("计划交期")
Dim bj As WinForm.TextBox = e.Form.Controls("报价金额")
Dim zz As WinForm.TextBox = e.Form.Controls("最终价格")
Dim dru1 As DataRow
dru1 = DataTables(fr & "订单核价系统").Find("客户 = '" & kh.Text & "'And 客户担当 = '" & kd.Text & "'And 类别 = '" & lb.Text & "'And 品名 = '" & pm.Text & "'And 款号 = '" & ks.Text & "'And 样衣款号 = '" & yk.Text & "'")
Dim tm As String  = ProjectPath & "RemoteFiles\kt\" '指定目录文件夹
Dim gps() As  String  = {"面料","辅料","二次加工"} '定义分组名称
Dim te() As String = {"客户","客户担当","类别","品名","款号","样衣款号","报价数量","计划交期","原料费用","辅料费用","二次加工费用","工缴费用","其他费用","管理费用","核价金额","技术担当"}
Dim cls() As String = {"款号","样衣款号","项目名称","规格","成份或质地","克重","门幅","单位","单耗","单价","金额","供应商","分类"} '定义列名
Dim lxs() As Object = {"String","String","String","String","String","Short","String","String","Double","Double","Double","String","String"} '定义Type类型
Dim wdh() As String = {140,140,140,135,90,45,45,45,58,65,67,88,85}
Dim dtb As New DataTableBuilder("临时核价表")
For i As Integer = 0 To cls.Length - 1
    If lxs(i) = "String" Then
        dtb.AddDef(cls(i),Gettype(String))
    ElseIf lxs(i) = "Double" Then
        dtb.AddDef(cls(i),Gettype(Double))
    ElseIf lxs(i) = "Short" Then
        dtb.AddDef(cls(i),Gettype(Short))
    End If
Next
dtb.Build()
For i As Integer = 0 To cls.Length - 1
    Tables("临时核价表").Cols(cls(i)).Width  = wdh(i)
Next
For i As Integer = 0 To gps.Length - 1
    Dim dt As DataTable = DataTables(fr & gps(i) &"核价")
    Dim drs As List(Of DataRow) = dt.Select("款号 = '" & kss & "'and 样衣号 like '%" & yks & "%'","_sortkey")
    For Each dr As DataRow In drs
        Dim r As  DataRow = DataTables("临时核价表").AddNew()
        r("款号") = dr("款号")
        r("样衣款号") = dr("样衣号")
        r("项目名称") = dr(gps(i) & "名称")
        If dt.DataCols.Contains("规格") Then
            r("规格") = dr("规格")
        Else
            r("规格") = Nothing
        End If
        If dt.DataCols.Contains("成份") Then
            r("成份或质地") = dr("成份")
        ElseIf dt.DataCols.Contains("辅料质地") Then
            r("成份或质地") = dr("辅料质地")
        Else
            r("成份或质地") = Nothing
        End If
        If dt.DataCols.Contains("克重") Then
            r("克重") = dr("克重")
        Else
            r("克重") = Nothing
        End If
        If dt.DataCols.Contains("门幅") Then
            r("门幅") = dr("门幅")
        Else
            r("门幅") = Nothing
        End If
        r("单位") = dr("计量单位")
        r("单价") = dr("单价")
        If dt.DataCols.Contains("单耗") Then
            r("单耗") = dr("单耗")
        ElseIf dt.DataCols.Contains("数量") Then
            r("单耗") = dr("数量")
        End If
        r("金额") = dr("金额")
        r("供应商") = dr("供应商")
        r("分类") = gps(i)
    Next
Next
MainTable = Tables("临时核价表")
Dim de As Table = Tables("临时核价表")
Dim L1 As WinForm.Label = e.Form.Controls("L客户")
Dim L2 As WinForm.Label = e.Form.Controls("L客户担当")
Dim L3 As WinForm.Label = e.Form.Controls("L类别")
Dim L4 As WinForm.Label = e.Form.Controls("L品名")
Dim L5 As WinForm.Label = e.Form.Controls("L款号")
Dim L6 As WinForm.Label = e.Form.Controls("L样衣款号")
Dim L7 As WinForm.Label = e.Form.Controls("L报价数量")
Dim L8 As WinForm.Label = e.Form.Controls("L计划交期")
Dim F1 As WinForm.Label = e.Form.Controls("L原料费用")
Dim F2 As WinForm.Label = e.Form.Controls("L辅料费用")
Dim F3 As WinForm.Label = e.Form.Controls("L二次加工费用")
Dim F4 As WinForm.Label = e.Form.Controls("L工缴费用")
Dim F5 As WinForm.Label = e.Form.Controls("L其他费用")
Dim F6 As WinForm.Label = e.Form.Controls("L管理費用")
Dim Le() As String ={L1.text,L2.text,L3.text,L4.text,L5.text,L6.text}
Dim Fe() As String ={F1.text,F2.text,F3.text,F4.text,F5.text,F6.text}
Dim Tes() As String ={"客户","客户担当","类别","品名","款号","样衣款号"}
Dim fye() As String ={"原料费用","辅料费用","二次加工费用","工缴费用","其他费用","管理费用"}
Dim clsf() As String = {"项目名称","规格","成份或质地","克重","门幅","单位","单耗","单价","金额","供应商"} '定义列名
Dim App As New MSExcel.Application
Dim Wb As MSExcel.Workbook = App.WorkBooks.Add
Wb.WorkSheets(1).name = "核价表"
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
'------------------表头------------------------------------
Dim Rg As MSExcel.Range = Ws.Range("A1:P1")'指定任意单元格
App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
Rg.Merge  '合并指定区域的单元格
Rg.Value = e.Form.Controls("qymc").text & " " & e.Form.Controls("Label6").text
Rg.HorizontalAlignment = MSExcel.Constants.xlCenter
Rg.Font.Size = 14.25 '字号
Rg.Font.Bold = True   '加粗
Rg.RowHeight = 40 '行高40
Ws.Range("A1").ColumnWidth = 15  '列宽15磅
Ws.Range("B1").ColumnWidth = 9
Ws.Range("C1").ColumnWidth = 6
Ws.Range("D1").ColumnWidth = 7
Ws.Range("E1").ColumnWidth = 8
Ws.Range("F1:I1").ColumnWidth = 4.6
Ws.Range("J1").ColumnWidth = 1.8
Ws.Range("K1").ColumnWidth = 5
Ws.Range("L1").ColumnWidth = 7
Ws.Range("M1").ColumnWidth = 10
Ws.Range("N1").ColumnWidth = 23
Ws.Range("O1").ColumnWidth = 1
Ws.Range("P1").ColumnWidth = 8
'----------------------主表------------------------------
For i As Integer = 2 To 7
    '----------------------主表标题--------------------------
    Dim Rg1 As MSExcel.Range = Ws.Range("A" & i & ":" & "B" & i)'指定任意单元格
    Rg1.Merge  '合并指定区域的单元格
    Ws.Range("A" & i).Value = Le(i-2)
    '----------------------主表明细--------------------------
    Dim Rg2 As MSExcel.Range = Ws.Range("C" & i & ":" & "M" & i)'指定任意单元格
    Rg2.Merge  '合并指定区域的单元格
    Ws.Range("C" & i).Value = e.Form.Controls(tes(i-2)).text
Next
'--------------------------------------------------------
Dim Rg3 As MSExcel.Range = Ws.Range("A8:B8,C8:D8,E8:I8,J8:M8")'指定任意单元格
Rg3.Merge  '合并指定区域的单元格
Ws.Range("A8").Value = L7.text
Ws.Range("C8").Value = e.Form.Controls("报价数量").text
Ws.Range("E8").Value = L8.text
Ws.Range("J8").Value = Cdate(e.Form.Controls("计划交期").text)
Ws.Range("J8").NumberFormat = "yyyy年mm月dd日" '日期
If de.Count < 12
    Dim Rg7 As MSExcel.Range
    Rg7 = Ws.Range("B9:C9 ,D9:E9 ,I9:J9")'指定任意单元格
    Rg7.Merge  '合并指定区域的单元格
    Dim Rg8 As MSExcel.Range
    For i As Integer = 10 To 21
        Rg8 = Ws.Range("B" & i & ":" & "C" & i & ",D" & i & ":" & "E" & i & ",I" & i & ":" & "J" & i)'指定任意单元格
        Rg8.Merge  '合并指定区域的单元格
    Next
Else
    Dim Rg7 As MSExcel.Range
    Rg7 = Ws.Range("B9:C9 ,D9:E9 ,I9:J9")'指定任意单元格
    Rg7.Merge  '合并指定区域的单元格
    Dim Rg8 As MSExcel.Range
    For i As Integer = 10 To de.Count +13
        Rg8 = Ws.Range("B" & i & ":" & "C" & i & ",D" & i & ":" & "E" & i & "I" & i & ":" & "J" & i)'指定任意单元格
        Rg8.Merge  '合并指定区域的单元格
    Next
End If
Dim clF() As String = {"A","B","D","F","G","H","I","K","L","M"}'引用不连续的单元格区域
For i As Integer = 0 To clsf.Length - 1
    Dim RgC As MSExcel.Range
    RgC = Ws.Range(clF(i) & "9")  '引用单个单元格
    RgC.Value = clsf(i)
Next
Dim RgU As MSExcel.Range = Ws.UsedRange
Dim RgS As MSExcel.Range
RgS = Ws.Range("A10:" & "M" & RgU.Rows.Count)'指定任意单元格
RgS.BorderAround(MSExcel.XlLineStyle.xlContinuous,MSExcel.XlBorderWeight.xlThin,1)
Dim dvs As DataTable = DataTables("临时核价表")
Dim idx As Integer = 0
For Each ck As String In dvs.GetValues("分类","","分类 DESC")
    Dim Rgt As MSExcel.Range = Ws.Range("A" & idx+10 & ":M" & idx+10)
    Rgt.Merge
    Rgt.HorizontalAlignment = MSExcel.Constants.xlLeft
    Dim Rows = dvs.Select("分类='" & ck & "'","分类 DESC")
    Rgt.Value = ck
    Rgt.Font.Size = 8 '字号
    Rgt.Font.ColorIndex = 5 '颜色
    Rgt.RowHeight = 18 '行高18磅
    idx += 1
    Dim mcount As Integer = 0
    For r As Integer = 0 To Rows.Count - 1 '填入数据
        For o As Integer = 0 To clsf.Length - 1
            Dim Rgr As MSExcel.Range = Ws.Range(clF(o) & r+idx +10)
            Rgr.Value = Rows(r)(clsf(o))
            Rgr.ShrinkToFit = True
        Next
    Next
    idx += Rows.Count
Next
Dim Rgh As MSExcel.Range = Ws.UsedRange
Dim Rgf As MSExcel.Range = Ws.Range("N2:P" & Rgh.Rows.Count-6)
Rgf.Merge
Ws.Range("A2:M9,A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+2 ).RowHeight = 22 '行高22磅
Dim iemg As Image = GetImage(tm & dru1("样衣款号") & dru1("款号") & ".jpg")
Dim h As  Single = Rgf.Width / iemg.Width * iemg.Height
Dim z1 As  Single = Rgf.Height - h
If z1 >=0
    Dim T As  Single = z1 / 2
    ws.Shapes.AddPicture(tm & dru1("样衣款号") & dru1("款号") & ".jpg",  Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,Rgf.left, Rgf.Top + T, Rgf.Width,h)
Else
    Dim w As  Single = Rgf.Height / iemg.Height * iemg.Width
    Dim z2 As  Single = Rgf.Width - w
    Dim L As  Single = z2 / 2
    ws.Shapes.AddPicture(tm & dru1("样衣款号") & dru1("款号") & ".jpg",  Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,Rgf.left + l, Rgf.Top, w,Rgf.Height)
End If
Rgf.HorizontalAlignment = MSExcel.Constants.xlCenter
Rgf.VerticalAlignment = MSExcel.Constants.xlCenter
For i As Integer = Rgh.Rows.Count-5 To Rgh.Rows.Count
    Dim RgJ As MSExcel.Range = Ws.Range("N" & i & "," & "O" & i & ":P" & i)
    RgJ.Merge
    Ws.Range("N" & i).Value = Fe(i-Rgh.Rows.Count+5)
    Ws.Range("O" & i).Value = e.Form.Controls(fye(i-Rgh.Rows.Count+5)).text
    Ws.Range("O" & i).NumberFormat = "#,##0.00" '货币
Next
Dim Rgx As MSExcel.Range = Ws.Range("A" & Rgh.Rows.Count+1 & ":B" & Rgh.Rows.Count+1 & "," & "C" & Rgh.Rows.Count+1 & ":O" & Rgh.Rows.Count+1 & "," & "P" & Rgh.Rows.Count+1)
Rgx.Merge
Dim ve1 As String
Dim ve2 As String
Dim ve3 As String
If e.Form.Controls("核价金额").text = "核价金额"
    ve1 = "没有核价记录"
Else
    ve1 = e.Form.Controls("核价金额").text
End If
If e.Form.Controls("L报价金额1").text = "报价金额"
    ve2 = "未报价"
Else
    ve2 = e.Form.Controls("L报价金额1").text
End If
If e.Form.Controls("L最终价格1").text = "最终价格"
    ve3 = "无最终价格"
Else
    ve3 = e.Form.Controls("L最终价格1").text
End If
Ws.Range("A" & Rgh.Rows.Count+1).Value = e.Form.Controls("L核价金额").text
Ws.Range("C" & Rgh.Rows.Count+1).Value = "核价金额为:" & ve1 & " " & "元 报价金额为:" & ve2 & " " & "元 最终价格为:" & ve3 & " 元"
Ws.Range("P" & Rgh.Rows.Count+1).Value = e.Form.Controls("元").text
Ws.Range("C" & Rgh.Rows.Count+1 & ",P" & Rgh.Rows.Count+1).HorizontalAlignment = MSExcel.Constants.xlRight
Ws.Range("A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).Merge
Ws.Range("A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).Value =  e.Form.Controls("L制表人").text & " " & e.Form.Controls("技术担当").text
Ws.Range("A2:M9,A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).HorizontalAlignment = MSExcel.Constants.xlLeft
Ws.Range("A1:P" & Rgh.Rows.Count+2 ).Font.Name = "微软雅黑"
Ws.Range("A2:M9,N" & Rgh.Rows.Count-5 & ":P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+2 ).Font.Size = 11 '字号
Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous  '边框线型
Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.Weight = MSExcel.XlBorderWeight.xlThin '边框粗细
Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.ColorIndex = 1 '边框颜色'
With Ws.PageSetup
    .PrintArea = "A1:P" & Rgh.Rows.Count+2
    '.PrintArea = Ws.UsedRange.Address   '打印工作表的使用区域
    .LeftMargin = 30 '页面左边距
    .RightMargin = 30 '页面右边距
    .TopMargin = 50  '页面顶部边距
    .BottomMargin = 50   '页面底部边距
    .CenterHorizontally = True
    .Orientation = MSExcel.xlPageOrientation.xlLandscape '横向打印
    .Zoom = False '以下设置将缩印在一页内
    .FitToPagesWide = 1  '按照1页的宽度打印
    .FitToPagesTall = 1  '按照1页的高度打印
End With
Dim tmp As String = "d:\报价\" & dru1("客户") & "\" & dru1("样衣款号") & dru1("款号") & ".xlsx"
Dim rpt As String = "d:\报价\" & dru1("客户") & "\" & dru1("样衣款号") & dru1("款号") & ".pdf"
If FileSys.DirectoryExists("d:\报价\" & dru1("客户") & "\" ) Then '如果目录文件夹存在
    Wb.SaveAs(tmp)
Else
    FileSys.CreateDirectory("d:\报价\" & dru1("客户") & "\")
    Wb.SaveAs(tmp)
End If
Dim pdf = MSExcel.XlFixedFormatType.xlTypePDF
Wb.ExportAsFixedFormat(pdf,rpt)
App.Quit
Forms("窗口1").Open
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106209 积分：540168 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2020/4/7 8:45:00 [只看该作者]

查询赋值的代码可以参考：http://www.foxtable.com/webhelp/topics/2225.htm

其它地方没有什么可以优化的了
 回到顶部
帅哥哟，离线，有人找我吗？
hongye
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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

你帮我看看我的代码里查询赋值的代码怎么改

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106209 积分：540168 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2020/4/7 14:59:00 [只看该作者]

您使用的是Select方法，本来返回的就是集合，没啥改的了。

自己看看各段代码慢在什么地方：http://www.foxtable.com/webhelp/topics/2226.htm
[此贴子已经被作者于2020/4/7 14:59:31编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
hongye
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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

Dim Rg As MSExcel.Range = Ws.Range("A1:P1")'指定任意单元格
App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
Rg.Merge  '合并指定区域的单元格
Rg.Value = e.Form.Controls("qymc").text & " " & e.Form.Controls("Label6").text
Rg.HorizontalAlignment = MSExcel.Constants.xlCenter
Rg.Font.Size = 14.25 '字号
Rg.Font.Bold = True   '加粗
Rg.RowHeight = 40 '行高40
Ws.Range("A1").ColumnWidth = 15  '列宽15磅
Ws.Range("B1").ColumnWidth = 9
Ws.Range("C1").ColumnWidth = 6
Ws.Range("D1").ColumnWidth = 7
Ws.Range("E1").ColumnWidth = 8
Ws.Range("F1:I1").ColumnWidth = 4.6
Ws.Range("J1").ColumnWidth = 1.8
Ws.Range("K1").ColumnWidth = 5
Ws.Range("L1").ColumnWidth = 7
Ws.Range("M1").ColumnWidth = 10
Ws.Range("N1").ColumnWidth = 23
Ws.Range("O1").ColumnWidth = 1
Ws.Range("P1").ColumnWidth = 8

以上耗时1秒

With Ws.PageSetup
    .PrintArea = "A1:P" & Rgh.Rows.Count+2
    '.PrintArea = Ws.UsedRange.Address   '打印工作表的使用区域
    .LeftMargin = 30 '页面左边距
    .RightMargin = 30 '页面右边距
    .TopMargin = 50  '页面顶部边距
    .BottomMargin = 50   '页面底部边距
    .CenterHorizontally = True
    .Orientation = MSExcel.xlPageOrientation.xlLandscape '横向打印
    .Zoom = False '以下设置将缩印在一页内
    .FitToPagesWide = 1  '按照1页的宽度打印
    .FitToPagesTall = 1  '按照1页的高度打印
End With
Dim tmp As String = "d:\报价\" & dru1("客户") & "\" & dru1("样衣款号") & dru1("款号") & ".xlsx"
Dim rpt As String = "d:\报价\" & dru1("客户") & "\" & dru1("样衣款号") & dru1("款号") & ".pdf"
If FileSys.DirectoryExists("d:\报价\" & dru1("客户") & "\" ) Then '如果目录文件夹存在
    Wb.SaveAs(tmp)
Else
    FileSys.CreateDirectory("d:\报价\" & dru1("客户") & "\")
    Wb.SaveAs(tmp)
End If
Dim pdf = MSExcel.XlFixedFormatType.xlTypePDF
Wb.ExportAsFixedFormat(pdf,rpt)
App.Quit

以上耗时2.5秒

这两项耗时最厉害
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：106209 积分：540168 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2020/4/7 16:50:00 [只看该作者]

这些都没有什么搞头。都是Excel组件自己处理的。

 回到顶部
帅哥哟，离线，有人找我吗？
程序猿
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：115 积分：1064 威望：0 精华：0 注册：2019/10/31 15:02:00 		  发帖心情 Post By：2020/4/27 18:23:00 [只看该作者]

这代码写得图片点击可在新窗口打开查看

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05566 秒, 4 次数据查询