- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 277
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-12-23
|
- Private Sub CommandButton1_Click()
- [A2:H65536].ClearContents
- Dim ds As Object, ds1 As Object, d As Object, Arr(1 To 65536, 0 To 4), Men, i#, test$, k%, temp$, s&
- Men = Range([J2], [J65536].End(xlUp)).Value
- Set ds = CreateObject("Scripting.Dictionary") '°ê©w°²¤é
- Set ds1 = CreateObject("Scripting.Dictionary") '¸É¤W¯Z
- Set d = CreateObject("Scripting.Dictionary") '¸É¤W¯Z
- r = [M65535].End(xlUp).Row
- For i = 2 To r '°ê©w°²¤é
- temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
- ds.Add temp, i
- Next
- r = [O65536].End(xlUp).Row
- For i = 2 To r '¸É¤W¯Z
- temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
- ds1.Add temp, i
- Next
- r = DateAdd("yyyy", 1, Range("K1")) - 1
- For i = Range("K1") To r
- test = Month(i) & "," & Day(i)
- If Weekday(i, vbMonday) = 6 Then d(Month(i)) = d(Month(i)) + 1
- If (Weekday(i, vbMonday) <= 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then '¶g¤@¦Ü¶g¤¨Ã¦©°£MÄæ°ê©w°²¤é¥[¤J¸É¤W¯Z¤é
- If d(Month(i)) Mod 2 = 0 And Weekday(i, vbMonday) = 6 Then GoTo 10 '°¸¼Æ¶g¤»¸õ¹L
- s = s + 1
- Arr(s, 1) = i
- Arr(s, 2) = Month(i)
- Arr(s, 3) = Day(i)
- Arr(s, 4) = Weekday(i, 2)
- k = IIf(s Mod UBound(Men) = 0, UBound(Men), s Mod UBound(Men))
- Arr(s, 0) = Men(k, 1)
- End If
- 10
- Next
- [A2].Resize(s, 5) = Arr
- Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
- "=IF(WEEKDAY(RC[-3])=2,""¤@"",(IF(WEEKDAY(RC[-3])=3,""¤G"",(IF(WEEKDAY(RC[-3])=4,""¤T"",(IF(WEEKDAY(RC[-3])=5,""¥|"",(IF(WEEKDAY(RC[-3])=6,""¤"",(IF(WEEKDAY(RC[-3])=7,""¤»"",(IF(WEEKDAY(RC[-3])=1,""¤é"","""")))))))))))))"
- Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value
- End Sub
½Æ»s¥N½X ¦^´_ 4# man65boy |
|