標題: 再次請問一下.... [打印本頁]

---

作者: color790    時間: 2010-8-20 23:46     標題: 再次請問一下....

1.要在vba設條件,請問每個月的第2個禮拜一要怎麼寫

2.
Sub aaa()
For i = 549 To Worksheets("sheet1").Range("A1").End(xlDown).Row
If Cells(i, 10) > Cells(i, 11) Then
Set x = Cells(i, 8)
Do Until Cells(i, 10) < Cells(i, 11)     '紅色的i可以先加1嗎?也就是上面如果求出的i是5,這邊直接先代6,後面再每次以1增加,如果改成Do Until Cells(i+1, 10) < Cells(i, 11)這樣好像每次都增加2?
i = i + 1
Loop
Set y = Cells(i, 8)
x.Offset(, 23) = y - x
End If
Next
End Sub

謝謝各位~~~

---

作者: Hsieh    時間: 2010-8-20 23:51

如果for i=549 to 這個迴圈要每個i都執行到
建議進入do Until之前用一變數如r
r=i+1
Do Until Cells(r, 10) < Cells(r, 11)
Cells(r, 11)
r = r + 1
Loop

---

作者: color790    時間: 2010-8-22 00:08

謝謝Hsieh大的指導
再請問每個月的第2個禮拜一要怎麼寫?

---

作者: Luc    時間: 2010-8-22 04:29

每月第二個禮拜一，我是用算的，提供給您參考。

Sub nn()

Dim startdate As Date
Dim temp As Date

startdate = "2010/1/1"
currentmonth = 1
startcell = 1

Dim firstMonday As Boolean
firstMonday = False

For i = 0 To 365

temp = startdate + i

If currentmonth <> Month(temp) Then
GoTo forend
End If

If Weekday(temp, vbMonday) = 1 Then
    If firstMonday = False Then
    firstMonday = True
    GoTo forend
    End If

    Cells(startcell, 1) = temp
    startcell = startcell + 1
    firstMonday = False
    currentmonth = currentmonth + 1
End If

forend:
Next

End Sub

---

作者: GBKEE    時間: 2010-8-22 07:16

回復 3# color790

1. Sub Ex()
   
2.     Dim m%, d%, S$, Work_Day As Date
   
3.     For m = 1 To 12
   
4.         '每月的第一個工作天
   
5.         If m = 1 Then
   
6.             Work_Day = Evaluate("WORKDAY(""" & DateSerial(Year(Date), m, 1) & """,1)")
   
7.         Else
   
8.             Work_Day = DateSerial(Year(Date), m, 1)
   
9.             Do Until Weekday(Work_Day, vbMonday) <= 5
   
10.                 Work_Day = Work_Day + 1
    
11.             Loop
    
12.         End If
    
13.         For d = 1 To 11     '第一周到第二周 最大間隔數 2010/1月為例
    
14.             If DatePart("ww", DateSerial(Year(Date), m, d), vbMonday) > DatePart("ww", Work_Day, vbMonday) Then
    
15.                 S = S & Chr(10) & DateSerial(Year(Date), m, d)
    
16.                 Exit For
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     MsgBox S
    
21. End Sub

複製代碼

---

作者: color790    時間: 2010-8-22 09:02

謝謝GBKEE,Luc的幫忙,等會來試試~

---

作者: Hsieh    時間: 2010-8-22 22:33

回復 3# color790

1. Sub nn()
   
2. Dim Ar(12)
   
3. y = InputBox("輸入年度", , Year(Date))
   
4. For i = 1 To 12
   
5. k = 0: s = 1
   
6.    Do Until k = 2
   
7.       d = DateSerial(y, i, s)
   
8.       If Weekday(d, 2) = 1 Then k = k + 1
   
9.       s = s + 1
   
10.    Loop
    
11.    Ar(i - 1) = i & "月第2個星期一是" & d
    
12. Next
    
13. MsgBox Join(Ar, Chr(10))
    
14. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)