Office中国论坛/Access中国论坛

标题: 公司的工厂日历的模块代码，进行修改规整 [打印本页]

作者: yanwei82123300 时间: 2010-10-8 16:32
标题: 公司的工厂日历的模块代码，进行修改规整
下面是我公司的工厂日历的模块代码：它是有规律的每一个P几都是开始日期和结束日期减
请问有没有办法写一段万年历是的代码，免去每次都需要更改里面的日期的代码。
谢谢
Fisher2010年工厂日历
Function GetP(a As Date) As String

Dim Re As String
If a >= CDate("2009-10-1") And a <= CDate("2009-10-23") Then
      Re = "2010_P1"
ElseIf a >= CDate("2009-10-24") And a <= CDate("2009-11-20") Then
      Re = "2010_P2"
ElseIf a >= CDate("2009-11-21") And a <= CDate("2009-12-25") Then
      Re = "2010_P3"
ElseIf a >= CDate("2009-12-26") And a <= CDate("2010-01-22") Then
      Re = "2010_P4"
ElseIf a >= CDate("2010-01-23") And a <= CDate("2010-02-19") Then
      Re = "2010_P5"
ElseIf a >= CDate("2010-02-20") And a <= CDate("2010-03-26") Then
      Re = "2010_P6"
ElseIf a >= CDate("2010-03-27") And a <= CDate("2010-04-23") Then
      Re = "2010_P7"
ElseIf a >= CDate("2010-04-24") And a <= CDate("2010-05-21") Then
      Re = "2010_P8"
ElseIf a >= CDate("2010-05-22") And a <= CDate("2010-06-25") Then
      Re = "2010_P9"
ElseIf a >= CDate("2010-06-26") And a <= CDate("2010-07-23") Then
      Re = "2010_P10"
ElseIf a >= CDate("2010-07-24") And a <= CDate("2010-08-20") Then
      Re = "2010_P11"
ElseIf a >= CDate("2010-08-21") And a <= CDate("2010-09-30") Then
      Re = "2010_P12"
Else
End If

GetP = Re

End Function

Fisher2011年工厂日历

Function GetP(A As Date) As String

Dim Re As String
If A >= CDate("2010-10-1") And A <= CDate("2010-10-22") Then
      Re = "2011_P1"
ElseIf A >= CDate("2010-10-23") And A <= CDate("2010-11-19") Then
      Re = "2011_P2"
ElseIf A >= CDate("2010-11-20") And A <= CDate("2010-12-24") Then
      Re = "2011_P3"
ElseIf A >= CDate("2010-12-25") And A <= CDate("2011-01-21") Then
      Re = "2011_P4"
ElseIf A >= CDate("2011-01-22") And A <= CDate("2011-02-18") Then
      Re = "2011_P5"
ElseIf A >= CDate("2011-02-19") And A <= CDate("2011-03-25") Then
      Re = "2011_P6"
ElseIf A >= CDate("2011-03-26") And A <= CDate("2011-04-22") Then
      Re = "2011_P7"
ElseIf A >= CDate("2011-04-23") And A <= CDate("2011-05-20") Then
      Re = "2011_P8"
ElseIf A >= CDate("2011-05-21") And A <= CDate("2011-06-24") Then
      Re = "2011_P9"
ElseIf A >= CDate("2011-06-25") And A <= CDate("2011-07-22") Then
      Re = "2011_P10"
ElseIf A >= CDate("2011-07-23") And A <= CDate("2011-08-19") Then
      Re = "2011_P11"
ElseIf A >= CDate("2011-08-20") And A <= CDate("2011-09-30") Then
      Re = "2011_P12"
Else
End If

GetP = Re

End Function

Fisher2012年工厂日历

Function GetP(A As Date) As String

Dim Re As String
If A >= CDate("2011-10-1") And A <= CDate("2011-10-21") Then
      Re = "2012_P1"
ElseIf A >= CDate("2011-10-22") And A <= CDate("2011-11-18") Then
      Re = "2012_P2"
ElseIf A >= CDate("2011-11-19") And A <= CDate("2011-12-23") Then
      Re = "2012_P3"
ElseIf A >= CDate("2010-12-24") And A <= CDate("2012-01-20") Then
      Re = "2012_P4"
ElseIf A >= CDate("2012-01-21") And A <= CDate("2012-02-17") Then
      Re = "2012_P5"
ElseIf A >= CDate("2012-02-18") And A <= CDate("2012-03-24") Then
      Re = "2012_P6"
ElseIf A >= CDate("2012-03-25") And A <= CDate("2012-04-21") Then
      Re = "2012_P7"
ElseIf A >= CDate("2012-04-22") And A <= CDate("2012-05-19") Then
      Re = "2012_P8"
ElseIf A >= CDate("2012-05-20") And A <= CDate("2012-06-23") Then
      Re = "2012_P9"
ElseIf A >= CDate("2012-06-24") And A <= CDate("2012-07-21") Then
      Re = "2012_P10"
ElseIf A >= CDate("2012-07-22") And A <= CDate("2012-08-18") Then
      Re = "2012_P11"
ElseIf A >= CDate("2012-08-19") And A <= CDate("2012-09-30") Then
      Re = "2012_P12"
Else
End If

GetP = Re

End Function

作者: hjb016 时间: 2010-10-8 17:42
谢谢分享

作者: todaynew 时间: 2010-10-8 20:01
本帖最后由 todaynew 于 2010-10-8 20:03 编辑

下面是我公司的工厂日历的模块代码：它是有规律的每一个P几都是开始日期和结束日期减
请问有没有办法写一段 ...
yanwei82123300 发表于 2010-10-8 16:32

2009-10-23\2010-10-22\2011-10-21 这三个日期是个什么道理呢？
看不出有什么规律，是不是拍脑袋出来的日期。

作者: t小宝 时间: 2010-10-8 23:09

2009-10-23\2010-10-22\2011-10-21 这三个日期是个什么道理呢？
看不出有什么规律，是不是拍脑袋出来的日 ...
todaynew 发表于 2010-10-8 20:01

同感

作者: yanwei82123300 时间: 2010-10-9 08:06
我公司是以每年10-1日为财政年的起点下一年的9-30日为财政年末，在这一年中要根据每月的关帐日划分为12个财政月即：P1、P2------P12
见图片

作者: aslxt 时间: 2010-10-9 18:25
看了2010年和2011年的代码，是不是这样：
每年的10月1日为财政年度的起点，9月30日为财政年度的终点；
这个年度分成12账期，每个账期的截止日期必须是当月的自然月度还有大于等于5天、小于等于12天的那个星期五？那几天是用来集中处理特定账期事物的。
如果是这样的话，2012年的后面6个账期就不对了

作者: aslxt 时间: 2010-10-9 18:56
你应该用文字描述你的时间分段规则，然后才有解决问题的可能。
年度为：xxxx年-10月-1日~xxxx年-9月-30日
月度的不能由老板任意指定吧？总得有一个规定，例如“每个自然月的最后一个周五”，或...

作者: todaynew 时间: 2010-10-9 21:30

我公司是以每年10-1日为财政年的起点下一年的9-30日为财政年末，在这一年中要根据每月的关帐日划分为12个财 ...
yanwei82123300 发表于 2010-10-9 08:06

还是没怎么看懂，不知道是不是这么个意思：

[attach]43709[/attach]

[attach]43710[/attach]

作者: yanwei82123300 时间: 2010-10-10 11:57
todaynew老师首先谢谢帮助：但是请帮助完善一下您制作的例子，有点小问题：例如：2010年-1月份（开始日期为：2009-10-01截止日期为2009-10-23） 2月份为：2009-10-24-----2009-11-20）；
2011年-1月份为（2010-10-01----2010-10-22）2月份为（2010-10-23----2010-11-19）
再次感谢大家的帮助工厂日历是由财务部制定的（基本上都是星期五）

作者: todaynew 时间: 2010-10-10 19:07

todaynew老师首先谢谢帮助：但是请帮助完善一下您制作的例子，有点小问题：例如：2010年-1月份（开始日期为 ...
yanwei82123300 发表于 2010-10-10 11:57

是月末的哪个星期五？给你三个选择：
1、最后一个星期五；
2、倒数第二个星期五；
3、最近接20日的星期五。

作者: todaynew 时间: 2010-10-10 20:39
本帖最后由 todaynew 于 2010-10-11 07:01 编辑

[attach]43719[/attach]

[attach]43720[/attach]

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

作者: yanwei82123300 时间: 2010-10-11 08:20
todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片

作者: yanwei82123300 时间: 2010-10-11 08:23
非常感谢todaynew 老师的无私帮助

作者: aslxt 时间: 2010-10-11 08:40
本帖最后由 aslxt 于 2010-10-11 08:51 编辑

todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片
yanwei82123300 发表于 2010-10-11 08:20

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

作者: todaynew 时间: 2010-10-11 10:34
本帖最后由 todaynew 于 2010-10-11 11:11 编辑

todaynew 老师我查看了日历基本上都是倒数第二个星期五。具体请看上面的图片
yanwei82123300 发表于 2010-10-11 08:20

你没看明白吧？呵呵。

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

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

[attach]43728[/attach]

[attach]43727[/attach]

作者: yanwei82123300 时间: 2010-10-11 14:36
todaynew 老师谢谢帮助，您在11楼放置实例第三个日历
请问老师能否将范例中数据提取出来。谢谢！

作者: todaynew 时间: 2010-10-11 15:40
本帖最后由 todaynew 于 2010-10-11 16:17 编辑

todaynew 老师谢谢帮助，您在11楼放置实例第三个日历
请问老师能否将范例中数据提取出来。谢谢！
yanwei82123300 发表于 2010-10-11 14:36

11楼的第三例与15楼的示例算法一样，具体运用大体可以如下：
[attach]43741[/attach]

[attach]43744[/attach]

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

作者: yanwei82123300 时间: 2010-10-11 16:17
todaynew 老师：“请问老师能否将范例中数据提取出来”我的意思是输入：2011 就可以将2011年度的日历全部数据提取出来！谢谢

作者: todaynew 时间: 2010-10-11 17:14
本帖最后由 todaynew 于 2010-10-11 17:31 编辑

todaynew 老师：“请问老师能否将范例中数据提取出来”我的意思是输入：2011 就可以将2011年度的日历全部数 ...
yanwei82123300 发表于 2010-10-11 16:17

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

[attach]43753[/attach]

[attach]43755[/attach]

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

作者: yanwei82123300 时间: 2010-10-12 08:12
todaynew 老师我要提取日期的目的是将客户订单的需求日期与这个日期做链接目的是：1、看订单落在哪一个月？，哪一周？来分析订单的完成情况：为何没有按时完成？是何原因？
2、看物料的采购日期落在哪一个月？，哪一周？是否有延迟采购情况？采购的周期是否充足（LT)?
谢谢

作者: todaynew 时间: 2010-10-12 08:50

todaynew 老师我要提取日期的目的是将客户订单的需求日期与这个日期做链接目的是：1、看订单落在哪一个月？ ...
yanwei82123300 发表于 2010-10-12 08:12

最后的示例中已经给你写了两个函数，其中mnth函数就是用来返回相应数据的。

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--日历日期
'示例：
'
'select *,mnth(订单日期)(0) as 财政年,mnth(订单日期)(1) as 财政月,mnth(订单日期)(4) as 周 from 订单表
Dim str As String
Dim myMonth As Long
Dim A
Dim B(5)
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
      B(4) = DateDiff("ww", date0, mydate)
      Exit For
End If
Next
B(1) = myMonth
mnth = B
End Function

作者: yanwei82123300 时间: 2010-10-12 10:02
非常谢谢todaynew

帮助！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)