交叉表查询结果怎样缩减空格 - Office中国论坛/Access中国论坛

Function IsTblExist(strTableName As String) As Boolean
Dim obj As AccessObject
IsTblExist = False
For Each obj In CurrentData.AllTables
If obj.Name = strTableName Then
IsTblExist = True
Exit For
End If
Next
End Function
Private Sub Command0_Click()
Dim rs As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim tblrs As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim intCount As Long
Dim sSQL As String
Dim strSQL As String
Dim strFiledName As String
Set cnn = CurrentProject.Connection
If IsTblExist("tbl") Then
DoCmd.DeleteObject acTable, "tbl"
End If
strSQL = "CREATE TABLE tbl(餐次 string,"
sSQL = "select distinct 周 from 一周菜单 order by 周 desc"
rs.Open sSQL, cnn, adOpenKeyset, adLockReadOnly
Do While Not rs.EOF
strSQL = strSQL & rs.Fields(0) & " string,"
rs.MoveNext
Loop
strSQL = Left(strSQL, Len(strSQL) - 1) & ")"
cnn.Execute strSQL
rs.MoveFirst
tblrs.Open "tbl", cnn, adOpenKeyset, adLockOptimistic
Do While Not rs.EOF
strFiledName = rs.Fields(0)
sSQL = "select 餐次,菜名称,周 from 一周菜单 where 周='" & strFiledName & "'"
rst.Open sSQL, cnn, adOpenKeyset, adLockReadOnly
Do While Not rst.EOF
If rst.Fields("周") = "周一" Then
tblrs.AddNew
tblrs.Fields("餐次") = rst.Fields("餐次")
ElseIf intCount = 0 Then
tblrs.MoveFirst
intCount = intCount + 1
Else
tblrs.MoveNext
End If
tblrs.Fields(strFiledName) = rst.Fields("菜名称")
tblrs.Update
rst.MoveNext
Loop
rst.Close
rs.MoveNext
Loop
rs.Close
DoCmd.OpenTable "tbl", acViewNormal
Set rst = Nothing
Set tblrs = Nothing
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

SELECT id, 餐次, 菜名称, 周, "菜单" & DCount("id","一周菜单","周='" & [周] & "' And 餐次='" & [餐次] & "' And id<=" & [id]) AS 菜单
FROM 一周菜单

复制代码

TRANSFORM Last(A.菜名称) AS 菜名称之最后一条记录
SELECT A.餐次, A.周
FROM A
GROUP BY A.餐次, A.周
PIVOT A.菜单;

复制代码