以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  按周统计  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=118845)
--  作者：实话实说
--  发布时间：2018/5/12 7:47:00
--  按周统计
如何从表1(数据表)得到表2(统计表)

图片点击可在新窗口打开查看此主题相关图片如下：snap1.jpg
图片点击可在新窗口打开查看

图片点击可在新窗口打开查看此主题相关图片如下：snap2.jpg
图片点击可在新窗口打开查看
--  作者：有点蓝
--  发布时间：2018/5/12 8:51:00
--  
1、表2增加2个辅助列：周一、周日，类型日期型。
2、获取表一的最小日期和最大日期，先在表2生成此区间所有周的行
3、循环所有表一的行，通过日期查询在表2哪个周，再把营业额填入对应星期几的单元格中
--  作者：实话实说
--  发布时间：2018/5/13 6:57:00
--  
做了个实例，望能在窗口1的按钮中贴出代码。
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:周结.foxdb
--  作者：有点甜
--  发布时间：2018/5/13 10:16:00
--  
Dim dt1 As DataTable = DataTables("周结")
Dim dt2 As DataTable = DataTables("销售")
dt1.DataRows.Clear
Dim cs() As String = {"星期天","星期一","星期二","星期三","星期四","星期五","星期六"}
For Each dr As DataRow In dt2.Select("日期 is not null", "日期")
    Dim d As Date = dr("日期")
    Dim y As Integer = d.Year
    Dim w As Integer = d.DayOfWeek \'算出今天是星期几
    Dim d1 As Date = d.AddDays(-w) \'获取本周的第一天
    Dim d2 As Date = d.AddDays(6 - w) \'获取本周的最后一天
    Dim fdr As DataRow = dt1.find("周一 = #" & d1 & "# and 周二 = #" & d2 & "#")
    If fdr Is Nothing Then
        fdr = dt1.addnew
        fdr("周一") = d1
        fdr("周二") = d2
    End If
    Dim i As Integer = d.DayOfWeek
    fdr(cs(i)) += dr("营业额")
    fdr("合计") += dr("营业额")
Next
--  作者：实话实说
--  发布时间：2018/5/13 11:31:00
--  
4楼代码是将星期天作为一星期的第一天,(DayOfWeek)我需要星期一作为已星期的第一天
--  作者：有点甜
--  发布时间：2018/5/13 11:54:00
--  

Dim y As Integer = d.Year
Dim w As Integer = d.DayOfWeek \'算出今天是星期几
If w = 0 Then w = 7
Dim d1 As Date = d.AddDays(-w+1) \'获取本周的第一天
Dim d2 As Date = d.AddDays(6 - w + 1) \'获取本周的最后一天
--  作者：实话实说
--  发布时间：2018/5/13 12:08:00
--  
周一周日列没问题,但营业额对不上，下面代码问题吗？
Dim i As Integer = d.DayOfWeek
    fdr(cs(i)) += dr("营业额")
    fdr("合计") += dr("营业额")
Next
--  作者：y2287958
--  发布时间：2018/5/13 12:40:00
--  
试试以下这个代码
Dim 日期1 As String = "format(DateAdd(\'d\', -iif(DatePart(\'w\', 日期)=1,8,DatePart(\'w\', 日期))+2, 日期),\'yymmdd\')"
Dim 日期2 As String = "format(DateAdd(\'d\', -iif(DatePart(\'w\', 日期)=1,8,DatePart(\'w\', 日期))+8, 日期),\'yymmdd\')"
Dim bm As String = "窗口1_Table2"
Dim b As New SQLCrossTableBuilder(bm,"销售")
b.HGroups.AddExp("营业额_日期", "trim(str(" & 日期1 & "))+\'-\'+trim(str(" & 日期2 & "))")
b.VGroups.AddExp("星期","DatePart(\'w\', 日期)")
b.Totals.AddDef("营业额")
b.HorizontalTotal = True
Tables(bm).DataSource = b.Build(True)
Tables(bm).Cols("营业额_1").Move(Tables(bm).Cols.Count-2)
For Each c As Col In Tables(bm).Cols
    If len(c.Caption) = 5
        c.Caption = left(c.Caption,4) & "星期" & CLNum(CInt(right(c.Caption,1))-1)
    End If
    If c.Name = "营业额_1"
        c.Caption = "营业额_星期日"
    ElseIf c.Name = "合计"
        c.Caption = "营业额_合计"
    End If
Next
DataTables(bm).BuildHeader
Tables(bm).AutoSizeCols
\'注明:窗口控件table2不要绑定任何表
[此贴子已经被作者于2018/5/13 13:29:43编辑过]
--  作者：实话实说
--  发布时间：2018/5/13 13:34:00
--  
谢谢8楼代码，我还是期待回复7楼问题
--  作者：实话实说
--  发布时间：2018/5/13 14:06:00
--  
以下是修改过的代码和结果，营业额错位

图片点击可在新窗口打开查看此主题相关图片如下：snap1.jpg
图片点击可在新窗口打开查看

Dim dt1 As DataTable = DataTables("周结")
Dim dt2 As DataTable = DataTables("销售")
dt1.DataRows.Clear
\'Dim cs() As String = {"星期天","星期一","星期二","星期三","星期四","星期五","星期六"}
Dim cs() As String = {"星期一","星期二","星期三","星期四","星期五","星期六","星期天"}
For Each dr As DataRow In dt2.Select("日期 is not null", "日期")
    Dim d As Date = dr("日期")
    Dim y As Integer = d.Year
    Dim w As Integer = d.DayOfWeek \'算出今天是星期几
    Dim d1 As Date = d.AddDays(-w+1) \'获取本周的第一天
    Dim d2 As Date = d.AddDays(6 - w+1) \'获取本周的最后一天
    Dim fdr As DataRow = dt1.find("周一 = #" & d1 & "# and 周日 = #" & d2 & "#")
    If fdr Is Nothing Then
        fdr = dt1.addnew
        fdr("周一") = d1
        fdr("周日") = d2
    End If
    Dim i As Integer = d.DayOfWeek
    fdr(cs(i)) += dr("营业额")
    fdr("合计") += dr("营业额")
Next