用查询（已附例）：表字段的记录添加到查询的字段记录

luhao

如主表A
流水单  备注
123
明细表B
流水单ID 产品   数量
123       产品1  5
123       产品2  15
查询结果如下：

流水单 备注 所有产品            所有数量
123           产品1、 产品2      20

这是很特殊的查询的。第一次例子传在三楼可能很难找，现再传在顶楼。请老师们指教。

Henry D. Sy

传例子

luhao

传例子
Henry D. Sy 发表于 2009-5-19 23:33

请过目

luhao

请问有没老师帮我可以解决

asklove

一个不太好的办法：
建个二个函数　产品字符　数量合计
产品字符：通过DISTINCT对流水单ID查询唯一值　循环用　＆　连起来生成你要的产品字符串
数量合计：也一样，用　＋　累加
（这样做就是感觉数据多的话会慢，期待有更好的办法）

Henry D. Sy

Private Sub Command8_Click()
    Dim rs As New ADODB.Recordset
    Dim rsSource As New ADODB.Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim a As String, b As Long
    Dim WhereArray() As String

    If IsHere("Newtbl") Then
        CurrentDb.Execute "drop table newtbl"
    End If
    strSQL = "create table Newtbl(流水号 text,备注 text ,产品 text,数量 long)"
    CurrentDb.Execute strSQL

    strSQL = "select distinct 流水单id from 明细表"
    With rsSource
        .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
        ReDim WhereArray(.RecordCount - 1) As String
        For i = 1 To .RecordCount
            WhereArray(i - 1) = .Fields(0)
            .MoveNext
        Next
        .Close
    End With
    With rs
        .Open "Newtbl", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        For i = 0 To UBound(WhereArray)
            strSQL = "select  * from 明细表 where 流水单id='" & WhereArray(i) & "'"
            rsSource.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
            Do While Not rsSource.EOF
                a = a & rsSource.Fields(1) & " "
                b = b + rsSource.Fields(2)
                rsSource.MoveNext
            Loop
            rsSource.Close
            .AddNew
            .Fields(0) = WhereArray(i)
            .Fields(2) = a
            .Fields(3) = b
            .Update
            a = ""
            b = 0
        Next
        .Close
    End With
    Set rs = Nothing
    Set rsSource = Nothing
    DoCmd.OpenTable "Newtbl"
End Sub

Function IsHere(tblName As String) As Boolean
    Dim tbl As DAO.TableDef
    IsHere = False
    For Each tbl In CurrentDb.TableDefs
        If tbl.Name = tblName Then
            IsHere = True
            Exit For
        End If
    Next
End Function

luhao

Private Sub Command8_Click()
    Dim rs As New ADODB.Recordset
    Dim rsSource As New ADODB.Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim a As String, b As Long
    Dim WhereA ...
Henry D. Sy 发表于 2009-5-21 11:49

首先多谢你，如果换成生成查询表，会不会很慢的