Office中国论坛/Access中国论坛

标题: 怎样列出与某个分类相关的字符 [打印本页]
作者: benhh    时间: 2009-7-26 09:48
标题: 怎样列出与某个分类相关的字符
本帖最后由 benhh 于 2009-7-27 06:44 编辑

希望我的题目不是太雷人了
我有一个表，大致如下

项目       资金        金额

项目A     资金1     10000
项目A     资金2     20000
项目A     资金3     30000
项目B     资金1     20000
项目B     资金2     30000

对项目进行统计查询之后，得出以下结果
项目A                 60000
项目B                 50000

当然资金是不能在这个查询内出现的，否则跟原来的表没有区别
我想做出这个结果

项目A    60000   资金1/资金2/资金3
项目B    50000   资金1/资金2

不知道能不能用自定义函数做到，我也可以用交叉查询实现，不过要分几步，有些麻烦，有没有高手懂？或者有没有朋友看过类似的自定义函数，请告诉我，谢谢！


[attach]39026[/attach]
作者: Henry D. Sy    时间: 2009-7-26 12:30
可以
不过您要传例子
作者: benhh    时间: 2009-7-27 06:48
多谢版主，例子已经上传，内有一个表和两个查询，请帮忙实现这种效果：

项目A    60000   资金1/资金2/资金3
项目B    50000   资金1/资金2

如果是您的自定义函数，请在注释里说明，谢谢！
作者: Henry D. Sy    时间: 2009-7-27 11:30
自定义函数

Public Function gStr(strGrp As String) As String
    Dim strTemp As String           '?????????
    Dim rs As New ADODB.Recordset   '??ado???
    Dim strSQL As String            '????????????sql??
    strSQL = "select ?? from ?1 where ??='" & strGrp & "'"      '?strSQL????
    With rs
        .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly     '?????
        Do While Not .EOF                   '??
            strTemp = strTemp & .Fields(0) & "/"   '??
            .MoveNext
        Loop
        .Close         '?????
    End With
    If Len(strTemp) <> 0 Then           '???????
        strTemp = Left(strTemp, Len(strTemp) - 1)
    End If
    gStr = strTemp       '????????????
    Set rs = Nothing     '????
End Function


查询A
SELECT 表1.项目, gStr([项目]) AS 新资金
FROM 表1;


查询B
SELECT 项目, Sum(金额) AS 总计
FROM 表1
GROUP BY 项目;

结果
SELECT DISTINCT A.项目, A.新资金, B.总计
FROM A INNER JOIN B ON A.项目 = B.项目;
作者: Henry D. Sy    时间: 2009-7-27 11:30
  1. Public Function gStr(strGrp As String) As String
  2.     Dim strTemp As String           '定义一个临时字符串
  3.     Dim rs As New ADODB.Recordset   '定义ado记录集
  4.     Dim strSQL As String            '定义一个字符串变量来保存sql语句
  5.     strSQL = "select 资金 from 表1 where 项目='" & strGrp & "'"      '给strSQL变量赋值
  6.     With rs
  7.         .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly     '打开记录集
  8.         Do While Not .EOF                   '循环
  9.             strTemp = strTemp & .Fields(0) & "/"   '叠加
  10.             .MoveNext
  11.         Loop
  12.         .Close         '关闭记录集
  13.     End With
  14.     If Len(strTemp) <> 0 Then           '去掉最后的“/”
  15.         strTemp = Left(strTemp, Len(strTemp) - 1)
  16.     End If
  17.     gStr = strTemp       '最后将临时变量还回给函数
  18.     Set rs = Nothing     '释放内存
  19. End Function
复制代码
作者: aslxt    时间: 2009-7-27 12:10
模块:
Function hBTXT(TX As String, TB As String, FD As String, TJFD As String)
  Dim conn As ADODB.Connection
  Set conn = CurrentProject.Connection
  Dim RecA As ADODB.Recordset
  Set RecA = New ADODB.Recordset
  
  Dim Str
  Str = "select DISTINCT " & FD & " from " & TB & " where " & TJFD & "='" & TX & "'"
  RecA.Open Str, conn, adOpenStatic, adLockReadOnly
  Select Case RecA.RecordCount
  Case 0
    hBTXT = ""
  Case 1
    hBTXT = RecA.Fields(0)
  Case Is > 1
    hBTXT = RecA.Fields(0)
    For i = 2 To RecA.RecordCount
      RecA.MoveNext
      hBTXT = hBTXT & "\" & RecA.Fields(0)
    Next i
  End Select
End Function
查询:
SELECT 表1.项目, Sum(表1.金额) AS 金额之总计, hBTXT([项目],"表1","资金","项目") AS 表达式1
FROM 表1
GROUP BY 表1.项目;
作者: 风啸啸    时间: 2009-7-27 13:21
学习了。
作者: benhh    时间: 2009-8-2 06:46
多谢版主，多谢aslxt同学，我回单位以后也弄出一个函数，不过时间太忙，直到周末才有时间上网和大家分享。

我的函数如下
Public Function CatList(ByVal qryname, refname, catname, productName As String) As String
On Error GoTo err_catlist
Dim temp2 As String
Dim dbs As Database
Dim rs As Recordset
Dim strSql As String

Set dbs = CurrentDb()

strSql = "SELECT [" & qryname & "]." & refname & ", [" & qryname & "]." & catname & " From [" & qryname & "] WHERE [" & qryname & "]." & refname & "= " & Chr(34) & productName & Chr(34) & ";"

Set rs = dbs.OpenRecordset(strSql, dbOpenSnapshot)

rs.MoveFirst
temp2 = rs.Fields(1)
Do While Not rs.EOF
  If InStr(temp2, rs.Fields(1)) = 0 Then
     temp2 = temp2 & " " & rs.Fields(1)
  End If
  rs.MoveNext
Loop
rs.Close
dbs.Close
CatList = temp2

err_catlist:
   Set rs = Nothing
   
End Function

我声明，没有偷看两位同学的作业：）

我上网查看了很多论坛资料和看了一本叫Access案例的书才做出的，没有版主和aslxt同学做的那么快，并且我对recordset 认识不多，不晓得它也可以用在查询中。
几点意见：版主的做法是教科书式的，Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly 的用法很经典，不过我发现类似Set rs = dbs.OpenRecordset(strSql, dbOpenSnapshot) 也行得通。Dim conn As ADODB.Connection
  Set conn = CurrentProject.Connection 的声明也很常见，不过似乎Access2003中可以不用。我自己对函数的测试结果，用在基于表的查询中很快，运行两千个记录大概用两秒，然而对基于查询的查询就显示出自定义函数的不足，占用内存极多，如果用慢一点的CPU只能逐行显示。再次多谢两位，我目前刚进入代码阶段，这些对我帮助很大，我会用两位的函数再进行比较，有时间再和大家分享。



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3