Office中国论坛/Access中国论坛

标题: 用查询（已附例）：表字段的记录添加到查询的字段记录 [打印本页]

作者: luhao 时间: 2009-5-19 22:24
标题: 用查询（已附例）：表字段的记录添加到查询的字段记录
本帖最后由 luhao 于 2009-5-20 18:40 编辑

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

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

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

作者: Henry D. Sy 时间: 2009-5-19 23:33
传例子

作者: luhao 时间: 2009-5-20 18:38

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

请过目

作者: luhao 时间: 2009-5-21 07:16
请问有没老师帮我可以解决

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

作者: Henry D. Sy 时间: 2009-5-21 11:49
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 时间: 2009-5-21 12:16
本帖最后由 luhao 于 2009-5-21 19:40 编辑

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

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

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)