设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
楼主: yanwei82123300
打印 上一主题 下一主题

[模块/函数] 公司的工厂日历的模块代码,进行修改规整

[复制链接]
11#
发表于 2010-10-10 20:39:04 | 只看该作者
本帖最后由 todaynew 于 2010-10-11 07:01 编辑





Function Calendar3(Ddate As Date) As String
'功能:每季度按445周的的工厂日历
Dim Mydate As Date
Dim str As String
Dim i As Long, j As Long, m

'计算第一个结账月
Mydate = DateSerial(Ddate - 1, 10, 1)
str = str & 1 & ";" & Mydate & ";"
If Weekday(Mydate, vbMonday) <> 6 Then
       Mydate = DateAdd("d", 21, Mydate)
       For j = 1 To 7
            If Weekday(Mydate, vbMonday) = 5 Then
                Exit For
            End If
            Mydate = DateAdd("d", 1, Mydate)
       Next
Else
       Mydate = DateAdd("d", 20, Mydate)
End If
str = str & Mydate & ";"
'计算2至11结算月,每季度中个月周数按445计算
m = 0
For i = 1 To 4
    For j = 1 To 3
        m = m + 1
        If m = 12 Then Exit For
        If m <> 1 Then
            str = str & m & ";" & DateAdd("d", 1, Mydate) & ";"
            If j <> 3 Then
                Mydate = DateAdd("d", 28, Mydate)
            Else
                Mydate = DateAdd("d", 35, Mydate)
            End If
            str = str & Mydate & ";"
        End If
    Next
    If m = 12 Then Exit For
Next
'计算最后一个结算月
str = str & m + 1 & ";" & DateAdd("d", 1, Mydate) & ";" & DateSerial(Ddate, 9, 30)

Calendar3 = str
End Function


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
12#
 楼主| 发表于 2010-10-11 08:20:29 | 只看该作者
todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
13#
 楼主| 发表于 2010-10-11 08:23:12 | 只看该作者
非常感谢todaynew 老师的无私帮助
14#
发表于 2010-10-11 08:40:44 | 只看该作者
本帖最后由 aslxt 于 2010-10-11 08:51 编辑
todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片
yanwei82123300 发表于 2010-10-11 08:20

楼主太不负责了,图中上面2行是倒数第二个周五,第三行是最后一个周五!
像这种不规律的划分,建议用表来记录划分期间的日期,然后用查询的方式确定某个日期是落在哪个【p】中,可以省略修改代码的麻烦,还可以把划分的权限交给那些有权指定某个月的截止日期的人,又不需要你修改代码。



15#
发表于 2010-10-11 10:34:50 | 只看该作者
本帖最后由 todaynew 于 2010-10-11 11:11 编辑
todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片
yanwei82123300 发表于 2010-10-11 08:20

你没看明白吧?呵呵。

我看的规律是每季度中各月的周数按照445分配。你看看这个万年历与你的实际数据之间是否吻合(注意你2012年度的后几个月的数据是错误的)。

我以为财务部门这样的分配周数是有意义的,因为其一是这样可以使得季度间的日历天数基本均衡;其二是财务报表是按季度出具的,季度的头两个月由于票据处理不及时,可能导致数据不准确,因此可以给头两个月分配较少的天数;其三是季度的末月天数较多,有利于帐务处理在规定时间内完成。






本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
16#
 楼主| 发表于 2010-10-11 14:36:16 | 只看该作者
todaynew 老师谢谢帮助,您在11楼放置实例第三个日历
请问老师能否将范例中数据提取出来。谢谢!
17#
发表于 2010-10-11 15:40:06 | 只看该作者
本帖最后由 todaynew 于 2010-10-11 16:17 编辑
todaynew 老师谢谢帮助,您在11楼放置实例第三个日历
请问老师能否将范例中数据提取出来。谢谢!
yanwei82123300 发表于 2010-10-11 14:36

11楼的第三例与15楼的示例算法一样,具体运用大体可以如下:





Function Calendar(Myyear As Long) As String
'功能:每季度按445周的的工厂日历
'参数:Myyear--财政年度
'示例:Me.日历.RowSource = "月度;首日;末日;" & Calendar(Me.年度.Value)
Dim mydate As Date
Dim str As String
Dim i As Long, j As Long, m
mydate = DateSerial(Myyear - 1, 10, 1)
str = str & 1 & ";" & mydate & ";"
If Weekday(mydate, vbMonday) <> 6 Then
    mydate = DateAdd("d", 21, mydate)
    For j = 1 To 7
        If Weekday(mydate, vbMonday) = 5 Then
                Exit For
        End If
        mydate = DateAdd("d", 1, mydate)
    Next
Else
    mydate = DateAdd("d", 20, mydate)
End If
str = str & mydate & ";"
m = 0
For i = 1 To 4
    For j = 1 To 3
        m = m + 1
        If m = 12 Then Exit For
        If m <> 1 Then
            str = str & m & ";" & DateAdd("d", 1, mydate) & ";"
            If j <> 3 Then
                mydate = DateAdd("d", 28, mydate)
            Else
                mydate = DateAdd("d", 35, mydate)
            End If
            str = str & mydate & ";"
        End If
    Next
    If m = 12 Then Exit For
Next
str = str & m & ";" & DateAdd("d", 1, mydate) & ";" & DateSerial(Myyear, 9, 30)
Calendar = str
End Function

Function mnth(mydate As Date) As Variant
'功能:按日历日期返回财政日历数组
'参数:mydate--日历日期
'示例:
'Dim A
'If IsDate(Me.日历日期) = True Then
      'A=mnth(Me.日历日期.Value)
      'Me.财政年度.Value = A(0)
      'Me.财政月度.Value =A(1)
      'Me.首日.Value = A(2)
      'Me.末日.Value = A(3)
'Else
    'MsgBox "日历日期不能为空!"
'End If
Dim str As String
Dim myMonth As Long
Dim A
Dim B(4)
Dim date0 As Date, date1 As Date
Dim i As Long
If Month(mydate) >= 10 And Month(mydate) <= 12 Then
    str = Calendar(Year(mydate) + 1)
    B(0) = Year(mydate) + 1
Else
    str = Calendar(Year(mydate))
    B(0) = Year(mydate)
End If
A = Split(str, ";")
For i = 0 To UBound(A, 1) Step 3
    myMonth = A(i)
    date0 = CDate(A(i + 1))
    date1 = CDate(A(i + 2))
    If CDate(mydate) >= date0 And CDate(mydate) <= date1 Then
        B(2) = date0: B(3) = date1
        Exit For
    End If
Next
B(1) = myMonth
mnth = B
End Function


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
18#
 楼主| 发表于 2010-10-11 16:17:19 | 只看该作者
todaynew 老师:“请问老师能否将范例中数据提取出来”我的意思是输入:2011 就可以将2011年度的日历全部数据提取出来!谢谢
19#
发表于 2010-10-11 17:14:06 | 只看该作者
本帖最后由 todaynew 于 2010-10-11 17:31 编辑
todaynew 老师:“请问老师能否将范例中数据提取出来”我的意思是输入:2011 就可以将2011年度的日历全部数 ...
yanwei82123300 发表于 2010-10-11 16:17

获得全部日历不困难,只是365次循环而已,问题在于这365个日期看他无益,瞅他没用。
因为你只需要一个具体的日历日期属于哪个财政年度和财政月度就可以了。所谓全部日期可以通过图示来查看,也可以从日历中选取某个日期来获得其所属的财政年度和财政月度。比如:





这样的一种处理思路就是所谓的黑箱理论,也就是说知道输入值得到输出值,至于在什么范围内计算和如何计算不必去关心。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
20#
 楼主| 发表于 2010-10-12 08:12:09 | 只看该作者
todaynew 老师我要提取日期的目的是将客户订单的需求日期与这个日期做链接目的是:1、看订单落在哪一个月?,哪一周?来分析订单的完成情况:为何没有按时完成?是何原因?
2、看物料的采购日期落在哪一个月?,哪一周?是否有延迟采购情况?采购的周期是否充足(LT)?
谢谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-17 03:36 , Processed in 0.082529 second(s), 32 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表