问题来了，请大虾帮忙看下
公司找了个人写了个VB+SQL关于仓库和生产管理的几个程序1.每次SQL一启动服务器内存就吃的差不多了，1G的内存要用掉800多M（老服务器，见笑了），这个是正常的吗，如不正常那问题会出在哪
2.生产管理有个从SQL导出到EXCEL的程序，每次导出的时候服务器CPU都是100%，每天都要导出的时候，服务器就和死机状态差不多，代码很长，因为他听说CPU是100%所以先把SQL数据搬到了本地的ACCSESS上再导出，可是还是一样，是数据量太大了还是什么原因
Private Sub print_fb(cj As String, dh As String) '导出分表
Label2.Caption = "从服务器导入数据……"
Dim elo As Excel.Application '定义EXCEL
Dim prtcj As ADODB.Recordset '定义车间
Dim prtzb As ADODB.Recordset '定义总表
Dim prtls As ADODB.Recordset '定义临时
Dim prtfb As ADODB.Recordset '定义分表
Dim cnn2 As ADODB.Connection '定义本地数据连接
Dim prtfks, prtlr, prtlc, prtsy, prtby As ADODB.Recordset
Dim row As Integer, col1 As String, col2 As String, i As Integer, j As Integer, eloname As String, l As Integer, lccjbh As String
Dim jsrq As Date
Dim ss As String
Dim cmdls As New ADODB.Command
Set elo = CreateObject("excel.application")
Set cnn2 = New ADODB.Connection
Set prtcj = New ADODB.Recordset
Set prtzb = New ADODB.Recordset
Set prtls = New ADODB.Recordset
Set prtfb = New ADODB.Recordset
Set prtfks = New ADODB.Recordset
Set prtlr = New ADODB.Recordset
Set prtlc = New ADODB.Recordset
Set prtsy = New ADODB.Recordset
Set prtby = New ADODB.Recordset
cnn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\temp.mdb;Persist Security Info=False"
cnn2.Open
cmdls.ActiveConnection = cnn2
cmdls.CommandType = adCmdText
cmdls.CommandText = "delete from 车间表 "
cmdls.Execute
cmdls.CommandText = "delete from 分表"
cmdls.Execute
cmdls.CommandText = "delete from 流程车间表 "
cmdls.Execute
cmdls.CommandText = "delete from 总表"
cmdls.Execute
Set cmdls = Nothing
'Call Main '输入数据
'*************************************
pid = Shell("工程1.exe", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
ExitEvent = WaitForSingleObject(hProcess, INFINITE)
Call CloseHandle(hProcess)
'*************************************
--------------------编程问答-------------------- 接上面的代码
Label2.Caption = "开始向EXECL导出数据……"
'Call Main
'On Error GoTo Err1
'row = 3
'col1 = ""
'col2 = "A"
'i = 0
'j = 0
elo.Workbooks.Open (App.Path + "\分表.xls")
If cj <> "" Then
cj = " where 车间 in(" & cj & ")"
End If
If dh <> "" Then
dh = " and 单号 in(" & dh & ")"
End If
'车间
prtcj.Open "select * from 车间表 " & cj & " order by 车间编号 DESC", cnn, adOpenKeyset, adLockReadOnly
If prtcj.RecordCount > 0 Then
ProgressBar1.Max = prtcj.RecordCount
ProgressBar1.Value = 0
While Not prtcj.EOF
row = 2
elo.Sheets.Add
elo.ActiveSheet.name = prtcj.Fields("车间")
eloname = prtcj.Fields("车间")
elo.Sheets("sheet1").Select
elo.Range("A1:CB1").Select
elo.Selection.Copy
elo.Sheets(eloname).Select
elo.ActiveSheet.Paste
'设置EXCEL格式
elo.Columns("B:C").NumberFormatLocal = "m-d"
'elo.Columns("A:G").HorizontalAlignment = xlCenter
elo.Columns("A:H").VerticalAlignment = xlCenter
'设置列宽
elo.Columns("A:F").ColumnWidth = 5
elo.Columns("J").ColumnWidth = 5
elo.Columns("S:CA").ColumnWidth = 5
elo.Columns("G:H").ColumnWidth = 7
'elo.Columns("E").ColumnWidth = 7
elo.Columns("J:R").ColumnWidth = 7
'elo.Columns("A:C,F,O:BX").ColumnWidth = 5
elo.Cells.Select
elo.Selection.Font.Size = 10
elo.Selection.Font.name = "Times New Roman"
elo.Selection.HorizontalAlignment = xlCenter
'设置行高
elo.Selection.RowHeight = 18
elo.Rows(1).RowHeight = 30
'设置日期格式
elo.Columns("D:E").NumberFormatLocal = "m-d"
'自动筛选
elo.Range("A1").Select
elo.Selection.AutoFilter
'分段开始和结束
'打开总表
'prtzb.Open "select 总表编号,客户,单号,货号,颜色,规格,数量 from 总表 where 总表编号 in(select 总表编号 from 流程车间表 where 车间编号='" & cjbh(prtcj.Fields("车间")) & "') " & dh & " order by 单号,总表编号", cnn, adOpenKeyset, adLockReadOnly
prtzb.Open "select z.总表编号,客户,单号,货号,颜色,规格,数量 from 总表 z,流程车间表 l where z.总表编号=l.总表编号 and 车间编号='" & cjbh(prtcj.Fields("车间")) & "' " & dh & " order by 单号,z.总表编号", cnn, adOpenKeyset, adLockReadOnly
If prtzb.RecordCount > 0 Then
ProgressBar2.Max = prtzb.RecordCount
End If
ProgressBar2.Value = 0
While Not prtzb.EOF
' Debug.Print Now()
'分段时间
ss = "select 开始日期,结束日期 from 流程车间表 where 车间编号 ='" & cjbh(prtcj.Fields("车间")) & "' and 总表编号=" & prtzb.Fields("总表编号")
prtfks.Open ss, cnn2, adOpenKeyset, adLockReadOnly
'流入正次品车间
ss = "select * from 流程车间表 l where l.总表编号=" & prtzb.Fields("总表编号") & " order by 结束日期"
prtls.Open ss, cnn2, adOpenKeyset, adLockReadOnly
prtls.Find "车间编号='" & cjbh(prtcj.Fields("车间")) & "'"
If Not prtls.BOF Then
prtls.MovePrevious
If Not prtls.BOF Then
lccjbh = prtls.Fields("流程车间编号")
Else
lccjbh = "0"
End If
Else
lccjbh = "0"
End If
prtls.Close
'流入正次品
ss = "select sum(正品) as 流入正品,sum(次品) as 流入次品 from 分表 where 正品<>-1 and datediff('m',日期,#" & DTPicker1.Value & "#)>=0 and 流程车间编号=" & lccjbh
prtlr.Open ss, cnn2, adOpenKeyset, adLockReadOnly
'流出正次品
'ss = "select sum(正品) as 流出正品,sum(次品) as 流出次品 from 分表 where 正品<>-1 and datediff('m',日期,#" & DTPicker1.Value & "#)>=0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "')"
ss = "select sum(正品) as 流出正品,sum(次品) as 流出次品 from 分表 f,流程车间表 l where f.流程车间编号=l.流程车间编号 and 正品<>-1 and datediff('m',f.日期,#" & DTPicker1.Value & "#)>=0 and 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "'"
prtlc.Open ss, cnn2, adOpenKeyset, adLockReadOnly
'上月
'ss = "select sum(正品) as 正品,sum(次品) as 次品 from 分表 where 正品<>-1 and datediff('m',日期,#" & DTPicker1.Value & "#)>0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "')"
ss = "select sum(正品) as 正品,sum(次品) as 次品 from 分表 f,流程车间表 l where f.流程车间编号=l.流程车间编号 and 正品<>-1 and datediff('m',f.日期,#" & DTPicker1.Value & "#)>0 and 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "'"
prtsy.Open ss, cnn2, adOpenKeyset, adLockReadOnly
'本月
'ss = "select 日期,正品,次品 from 分表 where datediff('m',日期,#" & DTPicker1.Value & "#)=0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "') order by 日期"
ss = "select f.日期,正品,次品 from 分表 f,流程车间表 l where f.流程车间编号 =l.流程车间编号 and (datediff('m',f.日期,#" & DTPicker1.Value & "#)=0 or 正品=-1 )and 总表编号=" & prtzb.Fields("总表编号") & " and 车间编号='" & cjbh(prtcj.Fields("车间")) & "' order by f.日期"
prtby.Open ss, cnn2, adOpenKeyset, adLockReadOnly
j = 0
col1 = ""
col2 = "A"
'分段开始和结束
'prtls.Open "select 开始日期,结束日期 from 流程车间表 where 车间编号 ='" & cjbh(prtcj.Fields("车间")) & "' and 总表编号='" & prtzb.Fields("总表编号") & "'", cnn, adOpenKeyset, adLockReadOnly
If prtfks.RecordCount > 0 Then
For i = 3 To prtfks.Fields.Count - 1 + 3
elo.Range(Chr(Asc("A") + i) & row).Value = prtfks.Fields(i - 3)
Next i
jsrq = prtfks.Fields("结束日期")
End If
prtfks.Close
'取车间序号
prtls.Open "select * from 流程车间表 where 总表编号=" & prtzb.Fields("总表编号") & " and 结束日期<=#" & jsrq & "# order by 结束日期", cnn2, adOpenKeyset, adLockReadOnly
elo.Range("A" & row).Value = prtls.RecordCount
prtls.Close
--------------------编程问答-------------------- 再接下，实在是长啊
'总表数据写入EXCEL
l = i
For i = i To prtzb.Fields.Count - 2 + l
elo.Range(Chr(Asc(col2) + i) & row).Value = prtzb.Fields(i + 1 - l)
Next i
'流入正次品数据
'prtls.Open "select * from 流程车间表 l where l.总表编号='" & prtzb.Fields("总表编号") & "' order by 结束日期", cnn, adOpenKeyset, adLockReadOnly
' prtls.find "车间编号='" & cjbh(prtcj.Fields("车间")) & "'"
'If Not prtls.BOF Then
' prtls.MovePrevious
' If Not prtls.BOF Then
' lccjbh = prtls.Fields("流程车间编号")
' Else
' lccjbh = ""
' End If
'Else
' lccjbh = ""
'End If
'prtls.Close
' prtlr.Open "select sum(正品) as 流入正品,sum(次品) as 流入次品 from 分表 where 正品<>-1 and datediff(month,日期,'" & DTPicker1.Value & "')>=0 and 流程车间编号='" & lccjbh & "'", cnn, adOpenKeyset, adLockReadOnly
If prtlr.Fields("流入正品") > 0 Then
elo.Range(Chr(Asc(col2) + i) & row).Value = prtlr.Fields("流入正品")
End If
i = i + 1
If prtlr.Fields("流入次品") > 0 Then
elo.Range(Chr(Asc(col2) + i) & row).Value = prtlr.Fields("流入次品")
End If
i = i + 1
prtlr.Close
'流出正次品数据
' prtls.Open "select sum(正品) as 流出正品,sum(次品) as 流出次品 from 分表 where 正品<>-1 and datediff(month,日期,'" & DTPicker1.Value & "')>=0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号='" & prtzb.Fields("总表编号") & "' and 车间编号='" & cjbh(prtcj.Fields("车间")) & "')", cnn, adOpenKeyset, adLockReadOnly
If prtlc.Fields("流出正品") > 0 Then
elo.Range(Chr(Asc(col2) + i) & row).Value = prtlc.Fields("流出正品")
End If
i = i + 1
If prtlc.Fields("流出次品") > 0 Then
elo.Range(Chr(Asc(col2) + i) & row).Value = prtlc.Fields("流出次品")
End If
i = i + 1
prtlc.Close
'流出车间
prtls.Open "select * from 流程车间表 l where l.总表编号=" & prtzb.Fields("总表编号") & " order by 结束日期", cnn2, adOpenKeyset, adLockReadOnly
prtls.Find "车间编号='" & cjbh(prtcj.Fields("车间")) & "'"
If Not prtls.EOF Then
prtls.MoveNext
If Not prtls.EOF Then
elo.Range(Chr(Asc(col2) + i) & row).Value = cjname(prtls.Fields("车间编号"))
End If
End If
prtls.Close
i = i + 1
'上月
'prtls.Open "select sum(正品) as 正品,sum(次品) as 次品 from 分表 where 正品<>-1 and datediff(month,日期,'" & DTPicker1.Value & "')>0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号='" & prtzb.Fields("总表编号") & "' and 车间编号='" & cjbh(prtcj.Fields("车间")) & "')", cnn, adOpenKeyset, adLockReadOnly
l = i
For i = i To prtsy.Fields.Count - 1 + l
If prtsy.Fields(i - l) > 0 Then
elo.Range(Chr(Asc(col2) + i) & row).Value = prtsy.Fields(i - l)
End If
Next i
prtsy.Close
'本月
' prtls.Open "select 日期,正品,次品 from 分表 where datediff(month,日期,'" & DTPicker1.Value & "')=0 and 流程车间编号 in(select 流程车间编号 from 流程车间表 where 总表编号='" & prtzb.Fields("总表编号") & "' and 车间编号='" & cjbh(prtcj.Fields("车间")) & "') order by 日期", cnn, adOpenKeyset, adLockReadOnly
l = i
While Not prtby.EOF
i = l + (Day(prtby.Fields("日期")) - 1)
j = i \ 26
i = i Mod 26
If j <> 0 Then
col1 = Chr(Asc("A") + j - 1)
Else
col1 = ""
End If
col2 = Chr(Asc("A") + i)
If prtby.Fields("正品") > "" And prtby.Fields("正品") <> 0 Then
' If prtby.Fields("正品") <> 0 Then
elo.Range(col1 & col2 & row).Value = Val(elo.Range(col1 & col2 & row).Value) + prtby.Fields("正品")
'End If
End If
i = l + (Day(prtby.Fields("日期")) - 1) + 31
j = i \ 26
i = i Mod 26
If j <> 0 Then
col1 = Chr(Asc("A") + j - 1)
End If
col2 = Chr(Asc("A") + i)
If prtby.Fields("次品") > "" And prtby.Fields("次品") <> 0 Then
'If prtby.Fields("次品") <> 0 Then
elo.Range(col1 & col2 & row).Value = Val(elo.Range(col1 & col2 & row).Value) + prtby.Fields("次品")
'End If
End If
prtby.MoveNext
Wend
prtby.Close
prtzb.MoveNext
row = row + 1
ProgressBar2.Value = ProgressBar2.Value + 1
'Debug.Print Now()
Wend
elo.Range("B" & row).Value = "制表日期：" & Date
'窗口冻结
elo.Range("O2").Select
elo.ActiveWindow.FreezePanes = True
'设置公式
For i = 2 To row - 1
elo.Range("B" & i).Value = "=IF(AND(TODAY()>=D" & i & ",L" & i & "=0),""异常"","""")"
elo.Range("C" & i).Value = "=IF(AND(TODAY()>=E" & i & ",N" & i & "<K" & i & "),""异常"","""")"
'elo.Rows(i).FormatConditions.Delete
'elo.Rows(i).FormatConditions.Add Type:=xlExpression, Formula1:="=$M" & i - 1 & ">=$J" & i
'elo.Rows(i).FormatConditions(1).Font.ColorIndex = 7
Next i
'加边
For i = 1 To 4
elo.Range("A1:CB" & row - 1).Borders(i).LineStyle = 1
Next i
'设置底色
elo.Range("L1:L" & row - 1).Interior.ColorIndex = 42
elo.Range("N1:N" & row - 1).Interior.ColorIndex = 42
'隐藏AB列
elo.Columns("A:C").EntireColumn.Hidden = True
prtzb.Close
prtcj.MoveNext
ProgressBar1.Value = ProgressBar1.Value + 1
Wend
Else
MsgBox "车间没有导入！", 16, "错误"
End If
Err1:
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, "提示"
End If
prtcj.Close
elo.Visible = True
Set elo = Nothing
cnn2.Close
Set cnn2 = Nothing
Set prtfks = Nothing
Set prtlr = Nothing
Set prtlc = Nothing
Set prtsy = Nothing
Set prtby = Nothing
Label2.Caption = ""
Set prtcj = Nothing
Set prtzb = Nothing
Set prtls = Nothing
Set prtfb = Nothing
End Sub --------------------编程问答-------------------- 工程1.exe 是什么？
感觉上是数据库的表的设立和数据的多少的关系。 --------------------编程问答-------------------- 那如果用数组填入EXCEL效率会好点吗 --------------------编程问答--------------------
应该没有用。一个包子放碗里盘里一样大。 --------------------编程问答-------------------- 我是菜鸟，关注中。。。 --------------------编程问答--------------------
-,- --------------------编程问答-------------------- 你可以试一下先将数据都取出来放到临时表或者记录集之后，再向excel中写效率应该会提高一些。还有循环的时候设置下doevents事件，否则循环过程中肯定是假死状态。 --------------------编程问答-------------------- 呵呵。每个人都这样不是自己写的东西看起来很麻烦的。
还是自己先慢慢研究先。怀疑那里有问题了再上来。 --------------------编程问答-------------------- 两个问题都不正常
--------------------编程问答-------------------- 1)可以在企业管理器中设置：服务器属性\内存。
2)查询方式不合理，应该用视图将关联数据一次性取得，不能在循环中再调用查询，这非常消耗时间。 --------------------编程问答-------------------- 我是来围观的······ --------------------编程问答-------------------- 这程序,简直没法看了,基本属于无法维护的一次性产品.
变量名太混乱, 还用了中文字段名和表名(不是不可以,个人不推荐), 功能模块化基本没有, 开头调用的那个工程1也没有说明.
Dim prtfks, prtlr, prtlc, prtsy, prtby As ADODB.Recordset
Dim row As Integer, col1 As String, col2 As String, i As Integer, j As Integer, eloname As String, l As Integer, lccjbh As String
看了这两句,实在是不知道写代码的人到底是懂VB的变量申明规则还是不懂VB的变量申明规则.
后面的代码别的不说,光是语句中的可优化的地方就太多太多了,程序结构和思路方面估计也是粗糙得很,这样的程序不慢太怪啊.
结论就是楼主的公司被人忽悠了,这程序写得实在是糟糕. 估计楼主没贴出来的代码也不大好看.
补充：VB , 基础类
