ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°Ý ARRAY½d³ò §ï¦¨ °ÊºA «ü©w ½d³ò°ÝÃD ½Ð«e½ú­Ì«ü±Ð

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-6-23 14:13 ½s¿è

¦^´_ 10# °a¤ªºµ

Å¥·Ç¤jªº~~§A´NÅý¤é´Á¦^Âk¨ì¤é´Á®æ¦¡¡A§O¥Î¤å¦r®æ¦¡ª±

¤é´Á®æ¦¡¬O¥i¥H°µ­pºâªº¡A¥Î¤é´Á®æ¦¡­pºâ¡Aºâ¨ì¦è¤¸3000¦~~³£¨S°ÝÃD

­nµo°Ý´N­n§â§Aªº°ÝÃD ´£¨ú¥X¨Ó¡A°µ¦¨Â²³æªºExcelÀɮסA¥i¥H°µ´ú¸Õ´N¦n

¤j³¡¤À¤H(¥]§t§Ú)¬Ý¨ì¤@¤j¦êµ{¦¡¡A´NÃiªº¥h¬ã¨s¤F¡A¦óªp¤j³¡¤Àµ{¦¡¸ò§A´£°Ýªº¤£¬Û¤z

©Ò¥H§Ú¥»¨Ó¬OÃi±o¦^§Aªº~

§Ú°µ¤@­Ó¤p½d¨ÒÅý§A°Ñ¦Ò§a¡A§Aªºµ{¦¡¤£¬Û¤zªºªF¦è¦³ÂI¦h¡AÃiªº¬ã¨s

Sub ª±¤é´Á()
Dim Date1 As Date, Date2 As Date
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date1 = InputBox("½Ð¿é¤J²Ä¤@¤Ñ¤W¯Z¤é´Á¡A" & vbCrLf & " »Ý­n¤é´Á®æ¦¡ Ex¡G2020/1/1")
  If Err <> 0 Then MsgBox "§A¿é¤Jªº¤£¬O¤é´Á®æ¦¡¡A½Ð­×§ï" Else CheckOK = True
  On Error GoTo 0
Loop
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date2 = InputBox("½Ð¿é¤J­n¬d¸ßªº¤é´Á¡A" & vbCrLf & " »Ý­n¤é´Á®æ¦¡ Ex¡G2020/7/1")
  If Err <> 0 Then MsgBox "§A¿é¤Jªº¤£¬O¤é´Á®æ¦¡¡A½Ð­×§ï" Else CheckOK = True
  On Error GoTo 0
Loop
Date1 = Date1 - 1
If Date2 - Date1 < 0 Then MsgBox "§A¿é¤Jªº¬d¸ß¤é´Á¤ñ²Ä¤@¤Ñ¤W¯Z¤éÁÙ«e­±": Exit Sub
'¥H°µ4¥ð2¬°¨Ò(6¤Ñ¤@´`Àô)
Select Case (Date2 - Date1) Mod 6
    Case 1, 2, 3, 4: MsgBox "³o¤Ñ­n¤W¯Z"
    Case 5, 6: MsgBox "®¥³ß!³o¤Ñ¬O¥ð°²^.^"
End Select
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

ÁÂÁ n7822123 ¤j¤jªº«ü±Ð  §Ú·|¦n¦n¬ã¨s¾Ç²ß ÁÂÁ±z
­ì¥»·|³o¼Ë¼g¬O¦]¬° ¸ûª½Ä± ¦n²z¸Ñ ¦ý·|³y¦¨­pºâ©M®æ¦¡°ÝÃD
§Ú·|Å¥·Ç¤j¤jªº §ï±¼³o­ÓÃa²ßºDªº   
ªº½T¤é´ÁÂà¤å¦r·|³y¦¨«Ü¦h¤£¥²­nªº°ÝÃD  ¤]·|¦]¬°Âà¤å¦r ¦h¼g¤F«Ü¦h¦æ ¤p§Ì¨ü±Ð¤F

TOP

¦^´_ 12# °a¤ªºµ

Å¥§Aªº¦^ÂСA·Pı§A¥i¥H¦Û¤v§¹¦¨¹Æ~

¥t¥~§Úªº½d¨Òµ{¦¡¦³ÂI¤p¿ù


Sub ª±¤é´Á()
Dim Date1 As Date, Date2 As Date
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date1 = InputBox("½Ð¿é¤J²Ä¤@¤Ñ¤W¯Z¤é´Á¡A" & vbCrLf & " »Ý­n¤é´Á®æ¦¡ Ex¡G2020/1/1")
  If Err <> 0 Then MsgBox "§A¿é¤Jªº¤£¬O¤é´Á®æ¦¡¡A½Ð­×§ï" Else CheckOK = True
  On Error GoTo 0
Loop
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date2 = InputBox("½Ð¿é¤J­n¬d¸ßªº¤é´Á¡A" & vbCrLf & " »Ý­n¤é´Á®æ¦¡ Ex¡G2020/7/1")
  If Err <> 0 Then MsgBox "§A¿é¤Jªº¤£¬O¤é´Á®æ¦¡¡A½Ð­×§ï" Else CheckOK = True
  On Error GoTo 0
Loop
Date1 = Date1 - 1
If Date2 - Date1 < 0 Then MsgBox "§A¿é¤Jªº¬d¸ß¤é´Á¤ñ²Ä¤@¤Ñ¤W¯Z¤éÁÙ«e­±": Exit Sub
'¥H°µ4¥ð2¬°¨Ò(6¤Ñ¤@´`Àô)
Select Case Int(Date2 - Date1) Mod 6
    Case 1, 2, 3, 4: MsgBox "³o¤Ñ­n¤W¯Z"
    Case 5, 0: MsgBox "®¥³ß!³o¤Ñ¬O¥ð°²^.^"
End Select
End Sub  
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-6-24 06:08 ½s¿è

n7822123¤j¤j §ÚÁÙ¬O¨S¿ìªk ¤£ª¾¹D¬°¬Æ»ò  ¤W±µ¤£¨ì¤U ¦³®É­Ô·|¶]¥¢±Ñ ¦pªG¥[©µ¿ð ¤SÅܱo«ÜºC
¤£¹L©µ¦ù¤U¤@¦~°ÝÃD ¸Ñ¨M¤F ¤w¸g¤£»Ý­n¥ý¦s¨ìÀx¦s®æ ³o¤èªk¬O¥i¥H¦Û°Ê©µ¦ù  ÁÂÁÂn7822123¤j¤j
Sub ¤é´Á½m²ß()
'Application.ScreenUpdating = False

Range(Cells(2, 1).End(xlToRight), Cells(2, 1).End(xlDown)).Clear

    S = 3
    E = 1
    For F = 1 To 12 '«Ø¥ß½d³ò
        For P = 1 To Day(DateSerial(Year(Now), F + 1, 0))
            Cells(S, E) = DateSerial(Year(Now), F, P)
            Cells(S - 1, E) = F & "¤ë" & P & "¤é" & WeekdayName(Weekday(P))
            E = E + 1
            If P = Day(DateSerial(Year(Now), F + 1, 0)) Then
            If F = 12 Then Exit For
               S = S + 2
               E = 1
            End If
        Next P
    Next F
   
    For E = ActiveWorkbook.Names.Count To 1 Step -1 '²M°£©w¸q¦WºÙ
       If ActiveWorkbook.Names(E).Name <> "«ü©w½d³ò" Then
          ActiveWorkbook.Names(E).Delete
       End If
    Next E
   
    Y = 65
    For i = 3 To Cells(3, 1).End(xlDown).Row Step 2 '©w¸q¦WºÙ
        ½d³ò¦WºÙ = Chr(Y)
        Names.Add Name:="²Ä" & ½d³ò¦WºÙ & "¶µ", RefersTo:=Range(Cells(i, 1), Cells(i, 1).End(xlToRight))
        Y = Y + 1
    Next i
    'Application.Wait Now + TimeValue("00:00:01")
   
    Set AWN = ActiveWorkbook.Names '¦X¨Ö
    For R = 1 To AWN.Count
       If R <> 1 Then
          K = Mid(AWN(R).RefersToR1C1Local, 2, Len(AWN(R))) & ","
       Else
          K = AWN(R).RefersToR1C1Local & ","
       End If
        u = u + K
    Next R
   
    Names.Add Name:="«ü©w½d³ò", RefersTo:=Mid(u, 1, Len(u) - 1)
   
    For E = ActiveWorkbook.Names.Count To 1 Step -1 '²M°£©w¸q¦WºÙ
       If ActiveWorkbook.Names(E).Name <> "«ü©w½d³ò" Then
          ActiveWorkbook.Names(E).Delete
       End If
    Next E

    For Each G In Range("«ü©w½d³ò")
        D = G.Offset
        Select Case DateAdd("d", -1, D) Mod 6 + 1
        Case 1 To 4
            G.Offset = "¤W¯Z"
            G.Offset.Font.Color = RGB(0, 0, 89)
            G.Interior.Color = RGB(150, 201, 123)
        Case 5 To 6
            G.Offset = "¥ð°²"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 255, 92)
        End Select
    Next G
   
'Application.ScreenUpdating = True
End Sub

TOP

¦pªG§â  G.Offset = "¤W¯Z" ©M G.Offset = "¥ð°²" Ãö±¼ ´N¤£·|¥X¿ù¤F ¦ý¬O ³o¼Ë´N¹F¤£¨ì¥Øªº¤F
¤£ª¾¹D¦³¨S¦³§Oªº¤è¦¡  
Select Case DateAdd("d", -1, D) Mod 6 + 1 ³o¬q¦³°ÝÃD  µ{¦¡¤w¸g¶]§¹¤F ¦ý¬OÁÙ¬O·|°±¦b³o¸Ì
»¡«¬ºA¤£²Å ¦ý§Úµ{¦¡¤w¸g¶]§¹¤F ¤£ª¾¹D¬°¬Æ»ò...
    For Each G In Range("«ü©w½d³ò")
        D = G.Offset
        Select Case DateAdd("d", -1, D) Mod 6 + 1
        Case 1 To 4
'            G.Offset = "¤W¯Z"
            G.Offset.Font.Color = RGB(0, 0, 89)
            G.Interior.Color = RGB(150, 201, 123)
        Case 5 To 6
'            G.Offset = "¥ð°²"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 255, 92)
        End Select
    Next G

TOP

­è¤~¦b³Ì«á ¦h¥[¤@­Ó°j°é §â¤å¦r¸òÃC¦â¤À¶} ´N¥i¥H¤F ¤S¬O®æ¦¡°ÝÃD
·PÁ    ·Ç¤j¤j ©M  n7822123 ¤j¤jªº«ü¾É
    For Each H In Range("«ü©w½d³ò")
        If H.Interior.Color = RGB(150, 201, 123) Then H.Offset = "¤W¯Z"
        If H.Offset.Interior.Color = RGB(255, 255, 92) Then H.Offset = "¥ð°²"
    Next H

TOP

¤l²Ó¬Ý¤F n7822123 ¤j¤jªº Sub ª±¤é´Á ()   µo²{
§â¥~­±¦A¥]¤@­Ó Int     D = Int(G.Offset)    ´N¥¿±`¤F¤£¥Î¦h¥[°j°é  >"<

TOP

¤½¦¡+VBA:
½m²ß¤é´Áv01.rar (23.29 KB)

¨º"±Æ¯Z"--¶È¥H [¤W?¥ð?] ¨Ó±Æ, ¤£¨ã¹ê¥Î©Ê, °Ñ¦Ò§a!
xx001.gif
2020-6-28 11:24

TOP

½Ð°Ý­ã´£¤j¤j¡@¦pªG­n³]©w´X½ü¤W¡@©]¯Z¡@¤é¯Z¡@°²³]¤@½ü¬O¢°¢±¤Ñ
¸Ó¦p¦ó¼g©O¡H
·Ç´£¤j¤jªºª©¥»¡@±Æª©§ó¬O²M·¡¡@¦ý§ÚÀ³¸Ó¦b­þ¤@¬q­×§ï¡@­n«ç»ò¼g¡H¡@

¥H¤U¬O¤§«e­×§ï¹Lªº¡@¦ý¹ï§Ú¨Ó»¡¤w¸g¬O·¥­­¤F¡D¡D¹ê¦b·Q¤£¥X¨Ó¡@¡ÖÈСÕ
°ÝÃD¥X¦b³o¸Ì¡G
¦pªG¥Î¡@ÈУ@£@ÈС@¶g¼Æ­pºâ¤W¯Zªº¤Ñ¼Æ´N·|¦³°ÝÃD¡D¡D¤£ª¾¦p¦ó­×§ï¡@
ÈТìÈФѼƷ|·f¤£¨ì¡@¡@
        Select Case DateAdd("d", -1, K) Mod Cells(1, 3) + 1   '±`¤é¯Z
        Case 1 To Cells(1, 4)
            G.Offset = "¤W¯Z"
            G.Offset.Font.Color = RGB(0, 0, 89)
            G.Interior.Color = RGB(150, 201, 123)
        Case Cells(1, 4) + 1 To Cells(1, 4) + Cells(1, 5)
            If G.Offset >= Cells(1, 1) Then
            G.Offset = "¥ð°²"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 255, 92)
            End If
        End Select
        
        Select Case DateAdd("d", -1, K) Mod Cells(1, 7) + 1 '©P½ü¯Z
        Case 1 To Cells(1, 4)
            G.Offset = "©]¯Z"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 208, 0)
        Case Cells(1, 4) + 1 To Cells(1, 4) + Cells(1, 5)
        End Select
¡@¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð
  1. Public Sub ©P½ü¯Z½m²ß()
  2. Range(Cells(2, 1).End(xlToRight), Cells(2, 1).End(xlDown)).Clear
  3. Cells(1, 3) = Cells(1, 4) + Cells(1, 5)
  4. Cells(1, 7) = Cells(1, 3) * 2
  5.    If Cells(1, 2) = "" Then
  6.       Cells(1, 2) = Year(Date)
  7.    Else
  8.       Cells(1, 2) = Cells(1, 2)
  9.    End If

  10.     S = 3
  11.     E = 1
  12.     For F = 1 To 12 '«Ø¥ß½d³ò
  13.         For P = 1 To Day(DateSerial(Cells(1, 2), F + 1, 0))
  14.             Cells(S, E) = DateSerial(Cells(1, 2), F, P)
  15.             Cells(S - 1, E) = F & "¤ë" & P & "¤é" & WeekdayName(Weekday(P))
  16.             E = E + 1
  17.             If P = Day(DateSerial(Cells(1, 2), F + 1, 0)) Then
  18.             If F = 12 Then Exit For
  19.                S = S + 2
  20.                E = 1
  21.             End If
  22.         Next P
  23.     Next F
  24.    
  25.     For E = ActiveWorkbook.Names.Count To 1 Step -1 '²M°£©w¸q¦WºÙ
  26.        If ActiveWorkbook.Names(E).Name <> "" Then
  27.           ActiveWorkbook.Names(E).Delete
  28.        End If
  29.     Next E
  30.    
  31.     Y = 65
  32.     For i = 3 To Cells(3, 1).End(xlDown).Row Step 2 '©w¸q¦WºÙ
  33.         ½d³ò¦WºÙ = Chr(Y)
  34.         Names.Add Name:="²Ä" & ½d³ò¦WºÙ & "¶µ", RefersTo:=Range(Cells(i, 1), Cells(i, 1).End(xlToRight))
  35.         Y = Y + 1
  36.     Next i
  37.    
  38.     Set AWN = ActiveWorkbook.Names '¦X¨Ö
  39.     For R = 1 To AWN.Count
  40.        If R <> 1 Then
  41.           K = Mid(AWN(R).RefersToR1C1Local, 2, Len(AWN(R))) & ","
  42.        Else
  43.           K = AWN(R).RefersToR1C1Local & ","
  44.        End If
  45.         U = U + K
  46.     Next R
  47.     Names.Add Name:="«ü©w½d³ò", RefersTo:=Mid(U, 1, Len(U) - 1)
  48.    
  49.     For E = ActiveWorkbook.Names.Count To 1 Step -1 '²M°£©w¸q¦WºÙ
  50.        If ActiveWorkbook.Names(E).Name <> "«ü©w½d³ò" Then
  51.           ActiveWorkbook.Names(E).Delete
  52.        End If
  53.     Next E
  54.    
  55.    If Cells(1, 1) = "" Then
  56.       Cells(1, 1) = Cells(3, 1)
  57.    Else
  58.       Cells(1, 1) = Cells(1, 1)
  59.    End If
  60.    
  61.     D = Cells(1, 1)
  62.    
  63.     For Each G In Range("«ü©w½d³ò") '©P½ü¯Z
  64.     If G.Offset >= Cells(1, 1) Then
  65.         If Weekday(G) = 1 Or Weekday(G) = 7 Then '¤»¤é¤W¦â
  66.            G.Offset(-1, 0).Interior.Color = RGB(172, 199, 213)
  67.         End If
  68.    
  69.         K = G.Offset
  70.         
  71.         Select Case DateAdd("d", -1, K) Mod 6 + 1   '±`¤é¯Z
  72.         Case 1 To 4
  73.             G.Offset = "¤W¯Z"
  74.             G.Offset.Font.Color = RGB(0, 0, 89)
  75.             G.Interior.Color = RGB(150, 201, 123)
  76.         Case 5 To 6
  77.             If G.Offset >= Cells(1, 1) Then
  78.             G.Offset = "¥ð°²"
  79.             G.Offset.Font.Color = RGB(114, 0, 55)
  80.             G.Offset.Interior.Color = RGB(255, 255, 92)
  81.             End If
  82.         End Select
  83.         
  84.         Select Case DateAdd("d", -1, K) Mod 12 + 1 '©P½ü¯Z
  85.         Case 1 To 4
  86.             G.Offset = "©]¯Z"
  87.             G.Offset.Font.Color = RGB(114, 0, 55)
  88.             G.Offset.Interior.Color = RGB(255, 208, 0)
  89.         Case 5 To 6
  90.         End Select
  91.         
  92.     End If
  93.     Next G
  94.    
  95. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-6-29 02:29 ½s¿è

°ÝÃD¸Ñ¨M¤F >"< ¦ý¬O³o¼gªk ¨Ã¤£¬O«Ü¦n  
«á¨Ó·Q¥X¨Óªº¿ìªk¬O¥Î ÃC¦â ¥h°µ§PÂ_
¤é´Áªº­pºâ ¹ê¦b¨S¿ìªk...¯uªº·Q¤£¥X¨Ó
¦A§â³Ì«áªºÃC¦â¼Æ­È¥ý¦s¨ìÀx¦s®æ
§ó§ï¤U¤@¦~¤§«á ¦A§âÃC¦â¼Æ­È¦s¦^ÅܼÆ...
¹ê¦b·Q¤£¥X¿ìªkªº¿ìªk...  §Æ±æ¦³§ó¦nªº¿ìªk
·Ç´£¤j¤jªºª©¥» ±Æª©§ó¬O²M·¡¡@
¦ý§ÚÀ³¸Ó¦b­þ¤@¬q­×§ï¡@­n«ç»ò¼g¡H

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD