主题：关于按判断自动写入

老师好：

         请帮看看，按判断自动写入指定内容，谢谢。

谢谢！

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:自动判断自动按要求录入.txt

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:将b表指定列内容.rar

1、afterOpenProject事件，直接填充数据，参考

 

http://www.foxtable.com/webhelp/scr/1533.htm

 

2、查找重复，参考

 

http://www.foxtable.com/webhelp/scr/0396.htm

 

3、不需要理会是否每月、每周第一天，直接判断当日的年月、年周，填充数据进去。

请老师帮处理下，刚才有一个附件“将B表指定列内容”没有上传成功，现在上传了，万分感谢！

afterOpenProject事件

 

Dim dt1 As DataTable = DataTables("表C")
Dim dt As DataTable = DataTables("表B")
Dim dt2 As DataTable = DataTables("表A")
Dim d As Date = Date.Today
Dim z As Integer = System.Globalization.CultureInfo.CurrentCulture.Calendar.GetWeekOfYear(d, Globalization.CalendarWeekRule.FirstDay, DayOfWeek.Monday).ToString
Dim nz As String = d.Year & "-" & format(z, "00")
Dim ny As String = Format(d, "yyyy-MM")
For Each dr As DataRow In dt.Select("状态='在职'")
    Dim filter1 As String = "年周 = '" & nz & "' and 工号 = '" & dr("工号") & "'"
    Dim filter2 As String = "年月 = '" & ny & "' and 工号 = '" & dr("工号") & "'"
    Dim fdr1 = dt1.find(filter1)
    If fdr1 Is Nothing Then
        fdr1 = dt1.AddNew
        fdr1("状态") = dr("状态")
        fdr1("工号") = dr("工号")
        fdr1("姓名") = dr("姓名")
        fdr1("职位") = dr("职位")
        fdr1("年周") = nz
    End If
    Dim fdr2 = dt2.find(filter2)
    If fdr2 Is Nothing Then
        fdr2 = dt2.AddNew
        fdr2("状态") = dr("状态")
        fdr2("工号") = dr("工号")
        fdr2("姓名") = dr("姓名")
        fdr2("职位") = dr("职位")
        fdr2("年月") = ny
    End If
Next

万分感谢有点甜老师，现在打开系统，能实现需求，请再帮看看：不知道什么原因，B表不能更新内容了，一更新内容，系统就闪退关闭了

万分感谢老师，还有就是我把互联网时间往后调，打开系统后A表和C表的内容写入了最新的年月和年周，但是之前写入的内容不见了。（之前写入的内容需要保留，当互联网时间更新后，按新日期条件追加年月/年周和几列对应的内容），请帮研究下，跪谢！

 

代码肯定没问题的，增加数据后，记得保存数据。

万分感谢有点甜大神老师，不好意思，刚才太激动，忘了保存了，重新修改日期，测试能够保存了，美中不足的是：1.在B表修改或增加新的内容，系统会自动退出。2.如果所调日期超过1周或1月，那么自动写入的年周或年月就接连不上顺序了，还望老师再帮看看，谢谢！

1、你datacolchanged事件写了什么代码？贴出你写的代码。

 

2、你可以循环每一周、每一月新增数据的，如（计算12-20到01-10，每一周的数据）

 

Dim sd As Date = "2017-12-20"
Dim ed As Date = "2018-01-10"
Dim dt1 As DataTable = DataTables("表C")
Dim dt As DataTable = DataTables("表B")
For i As Integer = 0 To Math.Ceiling((ed-sd).Totaldays / 7)
    Dim d As Date = sd.AddDays(7*i)
    Dim z As Integer = System.Globalization.CultureInfo.CurrentCulture.Calendar.GetWeekOfYear(d, Globalization.CalendarWeekRule.FirstDay, DayOfWeek.Monday).ToString
    Dim nz As String = d.Year & "-" & format(z, "00")
    Dim ny As String = Format(d, "yyyy-MM")
    For Each dr As DataRow In dt.Select("状态='在职'")
        Dim filter1 As String = "年周 = '" & nz & "' and 工号 = '" & dr("工号") & "'"
        Dim filter2 As String = "年月 = '" & ny & "' and 工号 = '" & dr("工号") & "'"
        Dim fdr1 = dt1.find(filter1)
        If fdr1 Is Nothing Then
            fdr1 = dt1.AddNew
            fdr1("状态") = dr("状态")
            fdr1("工号") = dr("工号")
            fdr1("姓名") = dr("姓名")
            fdr1("职位") = dr("职位")
            fdr1("年周") = nz
        End If
    Next
Next

谢谢有点甜老师，现在完全可以达到需求了，把ED日期设为为今天，然后把原来的bin文件删除后，编辑B表就不闪退了。万分感谢！