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

[µo°Ý] «ü©wªº®É¶¡´¡¤J¬ÛÃö¼Æ¾Ú

[µo°Ý] «ü©wªº®É¶¡´¡¤J¬ÛÃö¼Æ¾Ú

½Ð±Ð¦U¤j¤j/ª©¤j¡A­n¦b«ü©wªº®É¶¡´¡¤J¬ÛÃö¼Æ¾Ú(¥]¬A¨ú¥X³Ì¤j¤Î³Ì¤p¼Æ­È)¡AVBAÀ³¦p¦ó¼g¡A¸Ô²Ó¨£ªþ¥ó¤º®e¡AÁÂÁÂ!
test1.rar (18.01 KB)

¦^´_ 1# cdkee

¹Á¸Õ¤F¤@¨Ç¨Ò¤l¡A¥u°µ¨ì«ö®É¶¡´¡¤J³¡¥÷¸ê®Æ
test2.rar (34.64 KB)

¦A½Ð±Ð¦U¤j¤j¡A³o¸Ì§ä¨ì"Â^¨ú³Ì°ª³Ì§C"¨Ò¤l ©M "§ä´M«ü©w®É¶¡´¡¤J¬ÛÃö¸ê®Æ"¨Ò¤l¡AÀ³¸Ó¦p¦óµ²¦X¤~¯à°µ¨ì­n¨D¡AÁÂÁÂ!
  1. 'Â^¨ú³Ì°ª³Ì§C
  2. Private Sub Worksheet_Calculate()

  3.     Dim Rng As Range

  4.     Static Msg As Boolean    '¥H Static ³¯­z¦¡«Å§iªºÅܼơA¦bµ{¦¡°õ¦æ´Á¶¡¡A·|¤@ª½«O¯d¤º®e¡C

  5.     If Weekday(Date, vbMonday) > 5 Or Time < #5:46:00 PM# Or Time > #11:00:00 PM# Then Exit Sub  '«DÀç·~¤é ©Î «DÀç·~®É¶¡

  6.     If Msg = False Then

  7.         ²M°£Â¸ê®Æ

  8.         Msg = True

  9.     End If

  10.     With Cells(Rows.Count, "C").End(xlUp)

  11.         If .Row = 7 Then

  12.             Set Rng = .Offset(1)

  13.         Else

  14.             Set Rng = .Cells

  15.         End If

  16.     End With

  17.     If Rng = "" Or Rng.Text <> Format([b5], "hh:mm") Then

  18.         If Rng <> "" Then Set Rng = Rng.Offset(1)

  19.         Rng = Format([b5], "hh:mm")

  20.         Rng(1, 2) = [B6].Text

  21.         Rng(1, 3) = [B6].Text

  22.     ElseIf Rng.Text = Format([b5], "hh:mm") Then

  23.         If [B6] > Rng(1, 2) Then Rng(1, 2) = [B6].Text

  24.         If [B6] < Rng(1, 3) Then Rng(1, 3) = [B6].Text

  25.     End If

  26. End Sub
½Æ»s¥N½X
  1. '§ä´M©w®É¶¡´¡¤J¬ÛÃö¸ê®Æ
  2. Sub ¸ê®Æ¿é¤J()
  3.     Dim E As Range
  4.     '''''''''''''''''''''''''''''''''''''
  5.     'Dim Ar()      'Ar°}¦C ->  ¦s¤J§A­nªº¼Æ¾Ú
  6.     'Ar = Sheets("Table").Range("B2:D2").Value
  7.     '''''''''''''''''''''''''''''''''''''
  8.     Dim Ar(1 To 5)      'Ar°}¦C ->  ¦s¤J§A­nªº¼Æ¾Ú
  9.     Ar(1) = [Table!B2]
  10.     Ar(2) = [Table!C2]
  11.     Ar(3) = [Table!D2]
  12.     Ar(4) = [Table!E2]
  13.     Ar(5) = [Table!A2]
  14.     If Minute(Time) Mod 1 = 0 Then
  15.         Set E = Sheets("1¤ÀK").Range("A:A").Find(TimeSerial(Hour(Time), Minute(Time), 0))
  16.         E.Offset(0, 1).Resize(1, UBound(Ar)).Value = Ar 'Minute(Time) Mod 1=0  ¨C¤ÀÄÁ
  17.         
  18.        ElseIf Minute(Time) Mod 1 = 1 Then
  19.        E.Offset(0, 1).Resize(1, UBound(Ar)).Value = Ar
  20.     End If
  21.     'If Minute(Time) Mod 5 = 0 Then
  22.     '    Set E = Sheets("5¤ÀK").Range("A:A").Find(TimeSerial(Hour(Time), Minute(Time), 0))
  23.     '    E.Offset(0, 1).Resize(1, UBound(Ar)).Value = Ar 'Minute(Time) Mod 5=0  ¨C5¤ÀÄÁ
  24.     'End If
  25.     'If Minute(Time) Mod 15 = 0 Then
  26.     '    Set E = Sheets("15¤ÀK").Range("A:A").Find(TimeSerial(Hour(Time), Minute(Time), 0))
  27.     '    E.Offset(0, 1).Resize(1, UBound(Ar)).Value = Ar 'Minute(Time) Mod 15=0  ¨C15¤ÀÄÁ
  28.     'End If
  29.     If Time <= #4:15:00 PM# Then Application.OnTime TimeValue(Format(Time, "hh:MM:00")) + #12:01:00 AM#, "ThisWorkbook.¸ê®Æ¿é¤J"
  30.     ' ***  #4:15:00 PM# ¤§«e®É¶¡°õ¦æµ{¦¡ ->¸ê®Æ¿é¤J
  31.     Set E = Nothing    '
  32. End Sub
½Æ»s¥N½X

TOP

ª©¤W¦A§ä¨ìGBKEEª©¤j«Øijªº¨Ò¤l(#10)¡A¥[¤W¥H¤W¨â­Ó¨Ò¤l¡A¦A½Ð¤j¤j«ü±Ð¦p¦ó§ï¼g¡A·PÁÂ!
http://forum.twbts.com/viewthread.php?tid=7534&from=favorites
  1. '[µ¦²¤°O¿ý] ¤u§@ªíªºµ{¦¡½X(­«ºâ¨Æ¥ó )

  2. Private Sub Worksheet_Calculate()

  3.     Static Msg As Boolean                      '¥Î¥H§P©w¬O§_¬°¨C¤é²Ä¤@¦¸°õ¦æ

  4.     Static Time_Calculate As Date              '°O¿ý¨C¤ÀÄÁªº®É¶¡

  5.     Static AR                                  '°}¦C:°O¿ý¦¨¥æ»ù®æ

  6.     If Time < #8:30:00 AM# Then Exit Sub

  7.     Application.EnableEvents = False           '°±¤îª«¥ó¯àIJµo¨Æ¥ó(Worksheet_Calculate)

  8.     If Msg = False Then

  9.         Time_Calculate = TimeSerial(Hour(Time), Minute(Time), 0) '¨C¤ÀÄÁªº®É¶¡

  10.         Range("A12").CurrentRegion.Offset(1) = ""                '²M²z¬Q¤é¸ê®Æ

  11.         ReDim AR(0)                                              '­«·s³]¬°¤@¤¸¯À

  12.     End If

  13.     Msg = True

  14.     If Time >= Time_Calculate + #12:01:00 AM# Then

  15.             With IIf([A13] = "", [A13], Cells(Rows.Count, 1).End(xlUp).Offset(1))

  16.                 .Cells(1, 1) = Time_Calculate                    '®É¶¡

  17.                 .Cells(1, 2) = AR(0)                             '¶}½L»ù

  18.                 .Cells(1, 3) = Application.Max(AR)               '³Ì°ª»ù

  19.                 .Cells(1, 4) = Application.Min(AR)               '³Ì§C»ù

  20.                 .Cells(1, 5) = AR(UBound(AR))                    '¦¬½L»ù

  21.             End With

  22.             Time_Calculate = TimeSerial(Hour(Time), Minute(Time), 0)

  23.             ReDim AR(0)

  24.     End If

  25.     If AR(UBound(AR)) <> "" Then ReDim Preserve AR(UBound(AR) + 1) '­«·s¦A¥[¤W¤@¤¸¯À

  26.     AR(UBound(AR)) = [f2]                                          '°O¿ý¦¨¥æ»ù®æ¦¨¥æ»ù

  27.     Application.EnableEvents = True           '«ì´_ª«¥ó¯àIJµo¨Æ¥ó(Worksheet_Calculate)

  28. End Sub
½Æ»s¥N½X

TOP

test5.rar (13.39 KB)
ªþ¥ó¤w¸g¥i°µ¨ì¤j³¡¥÷­n¨D¡C
¦A½Ð±Ð¤j¤j¡A¦p¦ó°µ¨ì¨C­Ó°O¿ý®É¬q¶}©l®É¡A§Y­º­Ó¬íÄÁ>=00¡A¤Î¦b"B4"¦³§ïÅܮɡA¤~¶}©l°O¿ý?ÁÂÁÂ!

TOP

§ï¤F¤@¨Ç¡A¤´µM¤£¦æ¡A½Ð¤j¤jÀ°§U«ü±Ð¡AÁÂÁÂ!
  1. Option Explicit

  2. Private Sub Worksheet_Calculate()

  3.    
  4. Dim target As Range

  5.      Set target = Sheets("Sheet2").Range("B4")

  6.      If Not Intersect(target, Sheets("Sheet2").Range("B4")) Is Nothing Then


  7.     Dim rng As Range
  8.    
  9.    
  10.     Static Msg As Boolean    '¥H Static ³¯­z¦¡«Å§iªºÅܼơA¦bµ{¦¡°õ¦æ´Á¶¡¡A·|¤@ª½«O¯d¤º®e¡C

  11.     If Weekday(Date, vbMonday) > 5 Then Exit Sub    '«DÀç·~¤é ©Î «DÀç·~®É¶¡

  12.     If Msg = False Then

  13.         ²M°£Â¸ê®Æ

  14.         Msg = True

  15.     End If
  16.    
  17.    
  18.    
  19.      
  20.      

  21.     With Cells(Rows.Count, "C").End(xlUp)

  22.         If .Row = 7 Then

  23.             Set rng = .Offset(1)

  24.         Else

  25.             Set rng = .Cells

  26.         End If

  27.     End With

  28.     If rng = "" Or rng.Text <> Format(Worksheets("Sheet1").[a2], "hh:mm") Then

  29.         If rng <> "" Then Set rng = rng.Offset(1)

  30.         rng = Format(Worksheets("Sheet1").[a2], "hh:mm")
  31.         
  32.         rng(1, 2) = [B6].Text '

  33.         rng(1, 3) = [B6].Text

  34.         rng(1, 4) = [B6].Text
  35.         
  36.         rng(1, 5) = [B6].Text '

  37.     ElseIf rng.Text = Format(Worksheets("Sheet1").[a2], "hh:mm") Then

  38.         If [B6] > rng(1, 3) Then rng(1, 3) = [B6].Text

  39.         If [B6] < rng(1, 4) Then rng(1, 4) = [B6].Text
  40.         
  41.         rng(1, 5) = [B6].Text '

  42.     End If

  43. End Sub

  44. Private Sub ²M°£Â¸ê®Æ()

  45.     On Error GoTo Er

  46.     If [Àç·~¤é] <> Date Then            'Àˬd ©w¸q¦WºÙ:"Àç·~¤é"ªº­È

  47.         Me.Names.Add "Àç·~¤é", Date     '©w¸q¦WºÙ:"Àç·~¤é"ªº­È¬°·í¤é

  48.         If Weekday(Date, vbMonday) <= 5 Then Range([C8], [E8].End(xlDown)).Clear 'Àç·~¤é

  49.     End If

  50.     Exit Sub

  51. Er:  '³B¸Ì: ¨S¦³©w¸q¦WºÙ:"Àç·~¤é"ªº¿ù»~

  52.      Me.Names.Add "Àç·~¤é", Date        '©w¸q¦WºÙ:"Àç·~¤é"ªº­È¬°·í¤é

  53.      Resume Next                        '¦^¨ì¿ù»~ªº¤U¤@­Óµ{¦¡½X:Ä~Äò°õ¦æ

  54. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD