vba如何获得日期（*@#……@（）%（#&%（&%

yami251139 2008-10-17 11:34:08

昨天刚搞vba。。。
碰到一个问题。。。
================================
对一个月的最后一天所在的日期进行判断，是星期天，不处理，不是星期天，前半周的数据插入表a，后半周的数据插入表b。。。怎么搞？
================================
不能加载任何宏。。。eomonth是不能用的。。。

想到了取到每月开始的日期，但下面就不知道如何处理了。。。
year_no是Excel中取得的

thedate = theDate = Year_No + "/" + "01/" + "01"

month_no = month(thedate)

day_no = day(thedate)

if(month_no = month_no +1 and day_no = 1)then

    @()#&%)@#&%

郁闷饿。。。
今天帮忙搞定的人，明天早上0点1分的时候+100分单独结贴
今天搞不定就平均了。。。

...全文

1513 40 打赏收藏转发到动态举报

写回复

用AI写文章

40 条回复

切换为时间正序

请发表友善的回复…

发表回复

yami251139 2008-10-20

打赏
举报

果然是日期增长的不对。。。
等有空再改吧，先搞别的了。。。

sunyujia 2008-10-19

打赏
举报

Day_No = Day(theDate - 1 + (7 - Last_day))
改为
Day_No = Day(theDate - 1 + (7 - k))

sunyujia 2008-10-19

打赏
举报

Day_No = Day(theDate - 1 + (7 - Last_day))
改为
Day_No = Day(theDate - 1 + (7 - k))

sunyujia 2008-10-19

打赏
举报

纠正 Day_No = Day(theDate - 1 - ( Last_day-j ))
把j写成1了，其他地方的bug还没看，太晚了，眼神不好使了。

yami251139 2008-10-19

打赏
举报

调试过的程序，但跑的不对

Private Sub cmdCalendar_Click()

    On Error GoTo err

       

    Dim cn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    

    '定义数据库链接字符串

    Dim strCn As String

    Dim strSQL As String

    

    Dim Year_No As String

    Dim Month_No As String

    Dim Day_No As String

    Dim Del_Flg As String

    Dim Update_By As String

    Dim Created_By As String



    

    '定义数据库链接字符串

    'strCn = "Provider=;Server=;Database=;Uid=;Pwd=;"

   

    strCn = strConn

    cn.Open strCn

    

    '定义行数

    Dim RowCount As Integer

    RowCount = Sheet4.UsedRange.Rows.Count

    

    '定义时间

    Dim nowtime As Date

    nowtime = Now()

   

    '以行为单位开始循环

    Dim index As Integer

    For index = 3 To RowCount

        Year_No = Cells(index, 1).Value

        Update_By = Cells(index, 2).Value

        Created_By = Cells(index, 3).Value

        

        'parameter not null check

        Dim isEmpty As Boolean

        If (Year_No <> "" And Update_By <> "" And Created_By <> "") Then

            isEmpty = False

        Else

            isEmpty = True

        End If

        Debug.Print

        If (isEmpty) Then

            MsgBox ("Row " & index & " Data Empty")

        End If

        

        'Year check

        Dim numericCheck As Boolean

        numericCheck = IsNumeric(Year_No)

        If (numericCheck = False Or Year_No > "2999" Or Year_No < "1990") Then

            MsgBox ("No." & index & " Row的年度数据不正确。")

        Else

            Year_No = Year_No

        End If

        

        'length check

        If (Len(Update_By) > 20) Then

            MsgBox ("No." & index & " Row的Update By数据不正确。")

            Exit Sub

        End If

        If (Len(Created_By) > 20) Then

            MsgBox ("No." & index & " Row的Create By数据不正确。")

            Exit Sub

        End If

        

        'YearNo年度の週カレンダー情報をDBから削除する。

        strSQL = "Delete from M_CALENDAR Where YEAR_NO ='" & Year_No & "'"

        cn.Execute strSQL

        

        '插入[YearNo]年度的数据。

        

        '初始化日期

        Dim theDate As Date

        theDate = Year_No + "/" + "01/" + "01"

        

        '初始化周番号

        Dim Weekly_No As String

        If (Weekday(theDate) = vbMonday) Then

            Weekly_No = 0

        Else

            Weekly_No = 1

        End If

            

        '判断闰年

        Dim LeapYear As Boolean

        If (Year_No Mod 400 = 0 Or (Year_No Mod 100 <> 0 And Year_No Mod 4 = 0)) Then

            LeapYear = True

        Else

            LeapYear = False

        End If

            

        '根据是否闰年循环

        If (LeapYear = False) Then

            Dim i As Date

            For i = 0 To 364

            theDate = theDate + i

            Month_No = Month(theDate)

            Day_No = Day(theDate)

            Week_day = Weekday(theDate)

            

            '周累积

            If (Week_day = vbMonday) Then

                Weekly_No = Weekly_No + 1

            End If

            If (Weekly_No > 52) Then

                Weekly_No = 1

            End If

            

            '判断是否为跨月周

            Dim IsCross As Boolean

            If (Month_No = Month_No + 1 And Day_No = 1) Then

                IsCross = True

            Else

                IsCross = False

            End If

            

            '以周为单位处理

            Dim w As Integer

            For w = Weekly_No To 52 + Weekly_No

                If (IsCross = True And Weekday(theDate - 1) <> vbSunday) Then

                    '当月最后一天为星期几

                    Dim Last_day

                    Debug.Print theDate - 1

                    Last_day = DatePart("w", theDate - 1)

                      

                    '前半周

                    Dim j As Integer

                    For j = 1 To Last_day

                        Day_No = Day(theDate - 1 - (Last_day - 1))

                        Month_No = Month(theDate - 1)

                        Week_day = Weekday(theDate - 1)

                        If (Week_day = vbMonday) Then

                            Weekly_No = Weekly_No + 1

                        End If

                        If (Weekly_No > 52) Then

                            Weekly_No = 1

                        End If

                        

                        strSQL = "INSERT INTO M_CALENDAR(YEAR_NO ,MONTH_NO ,DAY_NO ,WEEKLY_NO ,WEEKLY_TYPE ,DEL_FLG ,LAST_UPDATE_BY ,LAST_UPDATE_DATE ,CREATED_BY ,CREATION_DATE  " & _

                    ")values('" & Year_No & "','" & Month_No & "','" & Day_No & "','" & Weekly_No & "'," & "'0'," & "'0','" & Update_By & "','" & nowtime & "','" & Created_By & "','" & nowtime & "')"

                        cn.Execute strSQL

                        strSQL = "INSERT INTO M_CALENDAR(YEAR_NO ,MONTH_NO ,DAY_NO ,WEEKLY_NO ,WEEKLY_TYPE ,DEL_FLG ,LAST_UPDATE_BY ,LAST_UPDATE_DATE ,CREATED_BY ,CREATION_DATE  " & _

                    ")values('" & Year_No & "','" & Month_No & "','" & Day_No & "','" & Weekly_No + a & "'," & "'1'," & "'0','" & Update_By & "','" & nowtime & "','" & Created_By & "','" & nowtime & "')"

                        cn.Execute strSQL

                    Next j

                    

                    '后半周

                    Dim k As Integer

                    For k = Last_day To 7

                        Day_No = Day(theDate - 1 + (7 - Last_day))

                        Month_No = Month(theDate)

                        Week_day = Weekday(theDate - 1)

                        If (Week_day = vbMonday) Then

                            Weekly_No = Weekly_No + 1

                        End If

                        If (Weekly_No > 52) Then

                            Weekly_No = 1

                        End If

                       

                         strSQL = "INSERT INTO M_CALENDAR(YEAR_NO ,MONTH_NO ,DAY_NO ,WEEKLY_NO ,WEEKLY_TYPE ,DEL_FLG ,LAST_UPDATE_BY ,LAST_UPDATE_DATE ,CREATED_BY ,CREATION_DATE  " & _

                    ")values('" & Year_No & "','" & Month_No & "','" & Day_No & "','" & Weekly_No & "'," & "'0'," & "'0','" & Update_By & "','" & nowtime & "','" & Created_By & "','" & nowtime & "')"

                        cn.Execute strSQL

                        strSQL = "INSERT INTO M_CALENDAR(YEAR_NO ,MONTH_NO ,DAY_NO ,WEEKLY_NO ,WEEKLY_TYPE ,DEL_FLG ,LAST_UPDATE_BY ,LAST_UPDATE_DATE ,CREATED_BY ,CREATION_DATE  " & _

                    ")values('" & Year_No & "','" & Month_No & "','" & Day_No & "','" & Weekly_No + b & "'," & "'2'," & "'0','" & Update_By & "','" & nowtime & "','" & Created_By & "','" & nowtime & "')"

                        cn.Execute strSQL

                    Next k

                End If

                If (IsCross = False) Then

                    Dim l As Integer

                    For l = 1 To 7

                    theDate = theDate + l

                    Month_No = Month(theDate)

                    Day_No = Day(theDate)

                    Week_day = Weekday(theDate)

                                        

                    strSQL = "INSERT INTO M_CALENDAR(YEAR_NO ,MONTH_NO ,DAY_NO ,WEEKLY_NO ,WEEKLY_TYPE ,DEL_FLG ,LAST_UPDATE_BY ,LAST_UPDATE_DATE ,CREATED_BY ,CREATION_DATE  " & _

                    ")values('" & Year_No & "','" & Month_No & "','" & Day_No & "','" & Weekly_No & "','" & 0 & "','" & 0 & "','" & Update_By & "','" & nowtime & "','" & Created_By & "','" & nowtime & "')"

                    

                    cn.Execute strSQL

                    Next l

                End If

                

            Next w

            Next i

        End If

    Next index

    cn.Close

    Exit Sub

    

err:

    MsgBox err.Description & Str(tmp)

    Exit Sub

End Sub

yami251139 2008-10-19

打赏
举报

上面那个4是行号。。。

yami251139 2008-10-19

打赏
举报

[Quote=引用 23 楼 yami251139 的回复:]
谁能帮我运行下。。。。
跑的老是错
要求
===================
每天插入条记录
有年，月，周，类型字段
如果当月的最后一天不是周日（定为叫跨月周）
则这周的前半周插入的时候类型为1
这周的后半周的类型为2
当然月分也要对。。。
头痛ing。。。补充下，以年为单位，每天都要插条记录（类型为0），跨月周则是两条，一条类型为0，另一条视前半还是后半而定（不是1就是2）了
并且1的话weekly_no字段后面+a，2的话+b，避免pk冲突
[/Quote]
=========================
[Quote=引用 28 楼 babyt 的回复:]
怕得出错是什么意思？程序跑不动还是跑下来后数据跑的不对？

这样没法去调试，提供下要操作的Excel样本和建库的脚本才行
而且既然核心问题已经解决了，VBA同样支持断点，报错时定位的功能，调试的问题应该比较容易解决才对

[/Quote]跑出错是数据能插入但插的不对。。。
程序能跑，但我个人觉得逻辑应该什么自己没注意到的地方有问题
excel样本很简单
就是上面一个button
下面就是第4行起（index）
======================
4 年号更新者创建者
- --- ------ ------
- --- ------ ------
- --- ------ ------
数据库字段就是插入的那些，但有4个pk
year_no,month_no,day_no,weekly_no,

sunyujia 2008-10-19

打赏
举报

[Quote=引用 38 楼 yami251139 的回复:]
引用 37 楼 sunyujia 的回复:
晕，还不行啊。就是每次insert前那几行你写的不对。
什么意思，判断不对？
[/Quote]
是日期增长的不对你在insert前msgbox

yami251139 2008-10-19

打赏
举报

[Quote=引用 37 楼 sunyujia 的回复:]
晕，还不行啊。就是每次insert前那几行你写的不对。
[/Quote]什么意思，判断不对？

sunyujia 2008-10-19

打赏
举报

晕，还不行啊。就是每次insert前那几行你写的不对。

yami251139 2008-10-19

打赏
举报

up。。。

yami251139 2008-10-19

打赏
举报

一会去上课了。。。再up下。。。。

yami251139 2008-10-18

打赏
举报

。。

阿泰 2008-10-18

打赏
举报

怕得出错是什么意思？程序跑不动还是跑下来后数据跑的不对？

这样没法去调试，提供下要操作的Excel样本和建库的脚本才行
而且既然核心问题已经解决了，VBA同样支持断点，报错时定位的功能，调试的问题应该比较容易解决才对

blues_zhao_yang 2008-10-17

打赏
举报



Public Class Form1

    'TextBox1：年份

    'TextBox2：月份

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim MyDate As Date

        Dim MyYear As Integer = TextBox1.Text

        Dim MyMonth As Integer = TextBox2.Text

        Dim MyDay As Integer

        '获取当月最后一天

        Select Case MyMonth

            Case 1, 3, 5, 7, 8, 10, 12

                MyDay = 31

            Case 4, 6, 9, 11

                MyDay = 30

            Case 2

                If Date.IsLeapYear(MyYear) Then

                    MyDay = 29

                Else

                    MyDay = 28

                End If

        End Select

        MyDate = MyYear & "-" & MyMonth & "-" & MyDay

        '判断

        If MyDate.DayOfWeek = DayOfWeek.Sunday Then

            '是星期天，不处理

        Else

            '不是星期天，前半周的数据插入表a，后半周的数据插入表b。。。

        End If

    End Sub

End Class

Forrest23 2008-10-17

打赏
举报

Dim s As New Date
Dim t As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
s = Me.TextBox4.Text.ToString.Trim '输入日期
t = Date.DaysInMonth(s.Year, s.Month)
a = s.Day
b = t - a
s = s.AddDays(b)
c = s.DayOfWeek
MsgBox(c)

满衣兄 2008-10-17

打赏
举报

<HTML>

	<HEAD>

		<title>WebForm7</title>

	</HEAD>

	<SCRIPT>

	function Refresh(_date)

	{

		 var myDate = new Date(_date.replace(/\-/g,'/'));

		 var week = '0123456'.charAt(new Date(myDate).getDay());

		 var retVal='';

		 if (week==0)

		 {

			retVal="不处理";

			return;

		 }

		 if (week<=3)

		 {

			retVal="上半周";

		 }

		 else

		 {

			retVal="下半周";

		 }

		 Time.innerHTML='0123456'.charAt(new Date(myDate).getDay())+retVal;

		 return retVal;

	}

</SCRIPT>



	<body onload="Refresh('2008-10-31');">

		<form id="Form1" method="post">

		<DIV style="background-color:#eeeeee" id="Time"></DIV>

		</form>

	</body>

</HTML>