专家坐堂-[求助]动态表填充（已解决）Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]动态表填充（已解决）  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=83720)

--  作者：yyzlxc
--  发布时间：2016/4/15 11:08:00
--  [求助]动态表填充（已解决）

动态生成的“工效分析”表，如何填充列标题（年月日），以及根据表标题填充工效值，请各位老师指教，谢谢！！

Dim rq As Date = Forms("扎包数据").Controls("DateTimePicker1").Value
Dim y As Integer = rq.Year
Dim m As Integer = rq.Month
Dim dt1 As New Date(y, m, 1) \'月初
Dim dt2 As New Date(y, m, Date.DaysInMonth(y, m)) \'月底
Dim gwid As String = Forms("扎包数据").Controls("TextBox2").Text
MainTable = Tables("工效分析")
DataTables("工效分析").DataRows.Clear()

\'删除条件列
Dim t As Table = Tables("工效分析")
For i As Integer = t.cols.count-1 To 0 Step -1
If t.cols(i).name <> "节拍序号" Then \'排除列
t.DataTable.DataCols.Delete(t.cols(i).name)
End If
Next

\'动态增加列
Dim b As Integer = DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'").Count
Dim j As Integer
For j = 1 To b
If DataTables("工效分析").DataCols.Contains("工效_" & j) = False Then
DataTables("工效分析").DataCols.Add("工效_" & j,Gettype(Double))
End If
Next
’填充节拍序号
Dim f As New Filler
f.SourceTable = DataTables("扎包数据") \'指定数据来源
f.SourceCols = "节拍序号" \'指定数据来源列
f.DataTable = DataTables("工效分析") \'指定数据接收表
f.DataCols = "节拍序号" \'指定数据接收列
f.Filter = "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'and 工位ID = \'" & gwid & "\'"
f.ExcludeExistValue = True
f.Fill()

\'动态填充表标题
With DataTables("工效分析")
.DataCols("工效_1").Caption = "" ‘时间段内的不重复年月日
.BuildHeader()
End With

\'条件填充工效
For Each dr As DataRow In DataTables("工效分析").DataRows
If dr.IsNull("节拍序号") = False Then
Dim pr As DataRow = DataTables("扎包数据").SQLFind("日期 = \'" & XXX & "\' And 节拍序号 = \'" & dr("节拍序号") & "\' And 工位ID = \'" & gwid & "\'")
If pr IsNot Nothing Then
dr("工效") = pr("工效")
End If
End If
Next

[此贴子已经被作者于2016/4/15 16:57:40编辑过]

--  作者：大红袍
--  发布时间：2016/4/15 11:16:00
--

增加列这样

For Each rq As String In DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'")
    If DataTables("工效分析").DataCols.Contains("工效_" & rq) = False Then
        DataTables("工效分析").DataCols.Add("工效_" & rq,Gettype(Double), rq)
    End If
Next

计算这样

For Each dr As Row In Tables("工效分析").Rows

If dr.IsNull("节拍序号") = False Then

Dim pr As DataRow = DataTables("扎包数据").SQLFind("日期 = \'" & dr.Caption & "\' And 节拍序号 = \'" & dr("节拍序号") & "\' And 工位ID = \'" & gwid & "\'")

If pr IsNot Nothing Then

dr("工效") = pr("工效")

End If

End If

Next

--  作者：yyzlxc
--  发布时间：2016/4/15 11:35:00
--
增加列出错！

此主题相关图片如下：捕获6.png

--  作者：大红袍
--  发布时间：2016/4/15 11:38:00
--

写错了

For Each rq As String In DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'")
    If DataTables("工效分析").DataCols.Contains("工效_" & rq) = False Then
        DataTables("工效分析").DataCols.Add("工效_" & rq,Gettype(Double), "", rq)
    End If
Next

--  作者：yyzlxc
--  发布时间：2016/4/15 11:44:00
--
要求时间格式为“yyyy-MM-dd”，如何调整?

--  作者：大红袍
--  发布时间：2016/4/15 11:45:00
--

For Each rq As String In DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'")

    rq = rq.Split(" ")(1)
    If DataTables("工效分析").DataCols.Contains("工效_" & rq) = False Then
        DataTables("工效分析").DataCols.Add("工效_" & rq,Gettype(Double), "", rq)
    End If
Next

--  作者：大红袍
--  发布时间：2016/4/15 11:46:00
--

或者

For Each rq As String In DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'")

    Dim d As Date = rq

    rq = Format(d, "yyyy-MM-dd")
    If DataTables("工效分析").DataCols.Contains("工效_" & rq) = False Then
        DataTables("工效分析").DataCols.Add("工效_" & rq,Gettype(Double), "", rq)
    End If
Next

--  作者：yyzlxc
--  发布时间：2016/4/15 11:53:00
--
日期排序有问题。

此主题相关图片如下：捕获7.png

--  作者：yyzlxc
--  发布时间：2016/4/15 11:57:00
--
填充工效代码出错！

此主题相关图片如下：捕获8.png

--  作者：大红袍
--  发布时间：2016/4/15 12:04:00
--

我测试没问题。试试

For Each rq As String In DataTables("扎包数据").SQLGetValues("日期", "日期 >= \'" & dt1 & "\' and 日期 <= \'" & dt2 & "\'", "日期")