怎样列出与某个分类相关的字符

benhh

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

项目       资金        金额

项目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

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

Henry D. Sy

可以
不过您要传例子

benhh

多谢版主，例子已经上传，内有一个表和两个查询，请帮忙实现这种效果：

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

如果是您的自定义函数，请在注释里说明，谢谢！

Henry D. Sy

自定义函数

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

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

模块:
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.项目;

风啸啸

学习了。

benhh

多谢版主，多谢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只能逐行显示。再次多谢两位，我目前刚进入代码阶段，这些对我帮助很大，我会用两位的函数再进行比较，有时间再和大家分享。