交叉表
'' 蔗区预付汇总表'Public Function yf_Zqtj(strQyjb As String, strShowlx As String) As adodb.Recordset Dim sql As String, nLen As Long, rsList As adodb.Recordset nLen = gBaseInfo.qyLevelLen(strQyjb) sql = _ " select left(z.qyid,{nlen}) qyid,min(qy.qymc) qymc,yfxm, t.lxid,rtrim(lx.mc) lxmc,sum(t.yfsl) yfsl,sum(t.znyfje) znyfje from (" + vbCrLf + _ " select jl.znid,'蔗种' as yfxm, jl.lxid, sum(jl.yfsl) yfsl,sum(znyfje) znyfje from yf_zzyfjl jl group by jl.znid,lxid union all" + vbCrLf + _ " select jl.znid,'化肥' as yfxm, jl.lxid, sum(jl.yfsl) yfsl,sum(znyfje) znyfje from yf_hfyfjl jl group by jl.znid,lxid union all" + vbCrLf + _ " select jl.znid,'农资' as yfxm, jl.lxid, sum(jl.yfsl) yfsl,sum(znyfje) znyfje from yf_nzyfjl jl group by jl.znid,lxid union all" + vbCrLf + _ " select jl.znid,'机耕' as yfxm, jl.lxid, sum(jl.yfsl) yfsl,sum(znyfje) znyfje from yf_jgyfjl jl group by jl.znid,lxid " + vbCrLf + _ " ) t left join zn_znxx z on t.znid=z.znid left join jc_qyxx qy on qy.qyid=left(z.qyid,{nlen}) " + vbCrLf + _ " left join yf_yflx lx on t.lxid=lx.id group by left(z.qyid,{nlen}),yfxm,t.lxid,lx.mc order by qyid,yfxm,t.lxid,lx.mc" Tools.sqlNum sql, "nlen", nLen Set rsList = PublicConn.Execute(sql) '构造结果集字段 sql = "select yfxm,rtrim(lx.mc) mc from (" + vbCrLf + _ " select distinct 1 xmid,'蔗种' yfxm, lxid from yf_zzyfjl union " + vbCrLf + _ " select 2 xmid,'化肥' yfxm,lxid from yf_hfyfjl union " + vbCrLf + _ " select 3 xmid,'农资' yfxm,lxid from yf_nzyfjl union " + vbCrLf + _ " select 4 xmid,'机耕' yfxm,lxid from yf_jgyfjl " + vbCrLf + _ ") t left join yf_yflx lx on t.lxid=lx.id order by xmid,lx.mc" Dim rsType As adodb.Recordset Set rsType = PublicConn.Execute(sql) Dim rsResult As New adodb.Recordset Tools.rsFieldAdd rsResult, "蔗区编码", rsList.fields("qyid") Tools.rsFieldAdd rsResult, "蔗区名称", rsList.fields("qymc") Tools.rsFieldAdd rsResult, "总数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, "总预付金额", rsList.fields("znyfje") Tools.rsFieldAdd rsResult, "蔗种|数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, "蔗种|预付金额", rsList.fields("znyfje") Tools.rsFieldAdd rsResult, "化肥|数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, "化肥|预付金额", rsList.fields("znyfje") Tools.rsFieldAdd rsResult, "农资|数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, "农资|预付金额", rsList.fields("znyfje") Tools.rsFieldAdd rsResult, "机耕|数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, "机耕|预付金额", rsList.fields("znyfje") While Not rsType.EOF Dim xmmc As String xmmc = rsType.fields("yfxm").value & "|" & rsType.fields("mc") Tools.rsFieldAdd rsResult, xmmc & "|数量", rsList.fields("yfsl") Tools.rsFieldAdd rsResult, xmmc & "|金额", rsList.fields("znyfje") rsType.MoveNext Wend rsResult.Open '往结果集插入记录 Dim preQyid As String, preYfxm As String, preLxmc As String Dim Qyid As String, Yfxm As String, Lxmc As String, yfsl As Double, znyfje As Double While Not rsList.EOF Qyid = rsList.fields("qyid").value Yfxm = rsList.fields("yfxm").value Lxmc = rsList.fields("Lxmc").value yfsl = rsList.fields("yfsl").value znyfje = rsList.fields("znyfje").value If Qyid <> preQyid Then '如果区域不同，则增行 rsResult.Addnew rsResult.fields("蔗区编码") = Qyid rsResult.fields("蔗区名称") = rsList.fields("qymc").value preQyid = Qyid End If rsResult.fields(Yfxm + "|" + Lxmc + "|数量") = yfsl rsResult.fields(Yfxm + "|" + Lxmc + "|金额") = znyfje rsList.MoveNext Wend '做列小计，计算行 总数量、总金额 Dim nYfsl As Double, nZnyfje As Double Dim sumYfsl As Double, sumZnyfje As Double Dim sumZzYfsl As Double, sumZzZnyfje As Double Dim sumHfYfsl As Double, sumHfZnyfje As Double Dim sumNzYfsl As Double, sumNzZnyfje As Double Dim sumJgYfsl As Double, sumJgZnyfje As Double Dim i As Long rsResult.MoveFirst While Not rsResult.EOF For i = (4 + 2 * 4) To rsResult.fields.count - 1 Step 2 Dim sName As String sName = rsResult.fields(i).name nYfsl = Tools.rsNum(rsResult, i) nZnyfje = Tools.rsNum(rsResult, i + 1) '总数量、总金额 sumYfsl = Tools.NumRound(sumYfsl + nYfsl, 4) sumZnyfje = Tools.NumRound(sumZnyfje + nZnyfje, 2) '分类数量 If (Left(sName, 2) = "蔗种") Then sumZzYfsl = Tools.NumRound(sumZzYfsl + nYfsl, 4) If (Left(sName, 2) = "化肥") Then sumHfYfsl = Tools.NumRound(sumHfYfsl + nYfsl, 4) If (Left(sName, 2) = "农资") Then sumNzYfsl = Tools.NumRound(sumNzYfsl + nYfsl, 4) If (Left(sName, 2) = "机耕") Then sumJgYfsl = Tools.NumRound(sumJgYfsl + nYfsl, 4) '分类金额 If (Left(sName, 2) = "蔗种") Then sumZzZnyfje = Tools.NumRound(sumZzZnyfje + nZnyfje, 2) If (Left(sName, 2) = "化肥") Then sumHfZnyfje = Tools.NumRound(sumHfZnyfje + nZnyfje, 2) If (Left(sName, 2) = "农资") Then sumNzZnyfje = Tools.NumRound(sumNzZnyfje + nZnyfje, 2) If (Left(sName, 2) = "机耕") Then sumJgZnyfje = Tools.NumRound(sumJgZnyfje + nZnyfje, 2) Next i rsResult.fields("总数量") = IIf(sumYfsl = 0, Null, sumYfsl) rsResult.fields("总预付金额") = IIf(sumZnyfje = 0, Null, sumZnyfje) rsResult.fields("蔗种|数量") = IIf(sumZzYfsl = 0, Null, sumZzYfsl) rsResult.fields("化肥|数量") = IIf(sumHfYfsl = 0, Null, sumHfYfsl) rsResult.fields("农资|数量") = IIf(sumNzYfsl = 0, Null, sumNzYfsl) rsResult.fields("机耕|数量") = IIf(sumJgYfsl = 0, Null, sumJgYfsl) rsResult.fields("蔗种|预付金额") = IIf(sumZzZnyfje = 0, Null, sumZzZnyfje) rsResult.fields("化肥|预付金额") = IIf(sumHfZnyfje = 0, Null, sumHfZnyfje) rsResult.fields("农资|预付金额") = IIf(sumNzZnyfje = 0, Null, sumNzZnyfje) rsResult.fields("机耕|预付金额") = IIf(sumJgZnyfje = 0, Null, sumJgZnyfje) sumYfsl = 0 sumZnyfje = 0 '分类数量 sumZzYfsl = 0 sumHfYfsl = 0 sumNzYfsl = 0 sumJgYfsl = 0 '分类金额 sumZzZnyfje = 0 sumHfZnyfje = 0 sumNzZnyfje = 0 sumJgZnyfje = 0 rsResult.MoveNext Wend rsResult.MoveFirst Set yf_Zqtj = rsResult ' Dim adoCmd As ADODB.Command, errmsg As String' Set adoCmd = New ADODB.Command' On Error GoTo err' With adoCmd' Set .ActiveConnection = PublicConn' .CommandText = "zz_yf_BB_Zqtj"' .CommandType = adCmdStoredProc' .Parameters("@StrQyjb") = strQyjb' .Parameters("@strShowlx") = strShowlx' Set rs = .Execute' errmsg = .Parameters("@errmsg")' If errmsg <> "" Then' MsgBox errmsg, vbCritical' Else' yf_Zqtj = True' End If' End With' Exit Function'err:' MsgBox "统计发生异常错误！" & vbCrLf & vbCrLf & err.Description, vbCriticalEnd Function