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

´Æ¤âªºexcel¹Bºâ°ÝÃD¡A¦p¦ó§ïµ½??

´Æ¤âªºexcel¹Bºâ°ÝÃD¡A¦p¦ó§ïµ½??

¥»©«³Ì«á¥Ñ ÂŤÑÄR¦À ©ó 2016-1-26 14:18 ½s¿è

©ú²ÓÅÜ°Ê°O¿ý.rar (148.6 KB)

ªþÀɬO¤@­Ó¤p§Ì¥­±`¥Î¦b¬ö¿ýªºexcel¥Ø«e¦³¨Ç´Æ¤âªº¹Bºâ°ÝÃDÁٳ·Ъ©¤W¤j¤jÀ°§Ú¤@¤U

¦p¹Ï©Ò¥Ü¡A¥ªÃä¬O§Ú¥­®É¦b¬ö¿ýªºÀx¦s®æ¡A¥kÃä¬O­pºâ¥ÎªºÀx¦s®æ¡A¦ý¬O¦]¬°¥kÃä­pºâªºÀx¦s®æ¸Ì­±§Ú¦³¼g¤@¨Ç¨ç¼Æ¡A³y¦¨¾ã­Óexcel¦b¶]ªº®É­Ô¥ªÃäµLªk¬ö¿ý©Î¬O¾ã­Ó·í±¼(¦]¬°©Ò¼g¨ç¼Æ¤Ó¦YCPU©M°O¾ÐÅé)¡A½Ð°Ý¤@¤Uª©¤W¤j¤j¤pªº³o­Ó°ÝÃDÀ³¸Ó«ç»ò¸Ñ¨M¤~¦n??

§Ú¦³·Q¥X¤@¨Ç¸Ñ¨M¤è¦¡¡AµL©`¹ïVBA¤£¬O¤Ó¼ô¡A¦b·Ð½Ðª©¤W°ª¤âÀ°À°¦£

¸Ñ¨M¤è¦¡
1.Åý¥ªÃäA-F¦C§Y®É¹Bºâ(A2-F2¬ODDE©Ò¥H»Ý­nÀH®É§ó·s¤~¯à±µ¦¬¸ê®Æ)¡AR-T¦C¨C¤ÀÄÁ¹Bºâ¤@¦¸¡A§ó·s§¹«á¼g¦¨­È¦Ó¤£¬O¤½¦¡¡A³o¼Ëªº¤è¦¡¥i¥H¶Ü??(¤£ª¾¹D¦P¤@­Ósheet¥i¤£¥i¥H¤£¦PÀW²v§Y®É¹Bºâ)

2.ÅܧóR-T¦Cªº¨ç¼Æ¼gªk¡AÅý¾ã­Óµ{¦¡¶]°_¨Ó¤£­n¨º»ò¦Y¸ê·½

3.±NS-T¦Cªº¨ç¼Æ¼g¦bVBA¸Ì­±¡A¨C¤ÀÄÁ°õ¦æ¤@¦¸°õ¦æ§¹«á±N¤½¦¡¼g¦¨­È

·Ð½Ðª©¤Wªº°ª¤â¤j¤jÀ°À°¤p§Ì

¦^´_ 40# c_c_lai

http://forum.twbts.com/viewthread.php?tid=16452&extra=
C¤j·s¦~§Ö¼Ö¡A¦³ªÅ¥i¥H³Â·ÐÀ°§Ú¬Ý¬Ý¶Ü??

TOP

¦^´_ 43# ÂŤÑÄR¦À


    «ÊÃö¤@¼Ë¥i¸Õ

TOP

¦^´_ 42# GBKEE


    G¤j¤µ¤Ñ¥xªÑ«ÊÃö¤F¡A­n¸Õ¤]­nµ¥¹L¦~«á¤F¡AÁÂÁ©p

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2016-2-3 10:34 ½s¿è

¦^´_ 38# ÂŤÑÄR¦À

ªþÀɸոլݬݥt¤@§@ªk

EX.rar (28.72 KB)
   



ThisWorkbook¼Ò²Õ
  1. Option Explicit
  2. Private Sub Workbook_BeforeClose(Cancel As Boolean) '
  3.     'ÀÉ®×Ãö³¬:Ãö³¬Àɮ׳sµ²
  4.     '**Àɮצb¶}±Ò®É,¤£±Ò°Ê¸ß°Ý§ó·s¸ê®Æªºµøµ¡
  5.    
  6.     ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
  7.     'UpdateLinks ÄÝ©Ê ¶Ç¦^©Î³]©w XlUpdateLink ±`¼Æ¡A¦¹±`¼Æ¥i«ü¥X¬¡­¶Ã¯§ó·s¤º´O OLE ³s½uªº³]©w¡CŪ/¼g¡C
  8.    
  9.     'XlUpdateLinks ¥i¥H¬O³o¨Ç XlUpdateLinks ±`¼Æ¤§¤@¡C
  10.     'xlUpdateLinksAlways ¥Ã»·§ó·s«ü©w¬¡­¶Ã¯ªº¤º´O OLE ³s½u¡C
  11.     'xlUpdateLinksNever ¥Ã»·¤£§ó·s«ü©w¬¡­¶Ã¯ªº¤º´O OLE ³s½u¡C
  12.     'xlUpdateLinksUserSetting  ®Ú¾Ú¨Ï¥ÎªÌ¹ï«ü©w¬¡­¶Ã¯ªº³]©w¨Ó§ó·s¤º´Oªº OLE ³s½u¡C
  13. End Sub

  14. Private Sub Workbook_Open()
  15.     Application.Calculation = xlAutomatic  ' ¬¡­¶Ã¯³]¬°¦Û°Ê­«ºâ
  16.     'Àɮצb¶}±Ò®É:¦Û°Ê§ó·s³sµ²
  17.     With ActiveWorkbook
  18.         .UpdateRemoteReferences = True
  19.         .SaveLinkValues = True
  20.     End With
  21. End Sub
½Æ»s¥N½X
Sheet1(Sheets("RTD")) ¼Ò²Õªºµ{¦¡½X
  1. Option Explicit
  2. Dim D As Object, xTime As Date, Volume As Double
  3. Private Sub Worksheet_Calculate()
  4.     If IsError([E2]) Or Time < #8:45:00 AM# Then Application.StatusBar = "µ¥­Ô¶}½L¤¤": Exit Sub
  5.    
  6.     '[E2] = "--" ¶}½L«eªº²Å¸¹
  7.    If Volume <> [E2] And [E2] <> "--" And Time >= #8:45:00 AM# And Time < #1:46:00 PM# Then
  8.         If D Is Nothing Then
  9.             Application.OnTime #1:46:00 PM#, "SHEET1.¬ö¿ý"  '¦¬½L«á±j¨î¼g¥X³Ì«á¤@¤ÀÄÁªº¸ê®Æ
  10.             Application.StatusBar = False
  11.             Set D = CreateObject("scripting.dictionary")
  12.             Range("A" & Rows.Count).End(xlUp).CurrentRegion.Offset(1) = ""
  13.             Sheets("¬ö¿ý").UsedRange.Clear
  14.             xTime = TimeSerial(Hour(Time), Minute(Time), 0)
  15.         End If
  16.         If TimeSerial(Hour([B2]), Minute([B2]), 0) <> xTime And D.Count > 0 Then ¬ö¿ý '¤U¤@¤ÀÄÁ¶}©l®É,¬ö¿ý¤W¤@¤ÀÄÁªº¬ö¿ý
  17.         D([C2].Value) = D([C2].Value) + IIf([D2] <= 10, -1, 1)    '¦r¨åª«¥ó:¬ö¿ý¦¨¥æ³æ¶q¤½¦¡ªº­È
  18.         Volume = [E2]
  19.         xTime = TimeSerial(Hour([B2]), Minute([B2]), 0)
  20.         '**************** °O¿ý¨C¦¸¦¨¥æ¬ö¿ý***************
  21.          With Range("A" & Rows.Count).End(xlUp).Offset(1)
  22.             .Cells(1) = [B2]                        '®É¶¡
  23.             .Cells(1, 2) = [C2]                     '¦¨¥æ»ù
  24.             .Cells(1, 3) = [D2]                     '¦¨¥æ³æ¼Æ
  25.             .Cells(1, 4) = IIf([D2] <= 10, -1, 1)   '¦¨¥æ³æ¶q¤½¦¡ªº­È
  26.         End With
  27.         '************************************************
  28.     End If
  29. End Sub
  30. Private Sub ¬ö¿ý()
  31.     Dim R As Integer, C As Integer, X As Integer
  32.     Application.EnableEvents = False
  33.     With Sheets("¬ö¿ý")
  34.         If .[A1] = "" Then .[A1] = "®É¶¡"
  35.         With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
  36.             R = .Row
  37.             .NumberFormat = "HH:MM"
  38.             .Value = xTime
  39.             .Resize(2).Merge
  40.         End With
  41.         C = 2
  42.         '°j°é:¦r¨åª«¥óªºKEY(ÃöÁä¦r) ³Ì¤j­È - ³Ì¤p­È.
  43.         For X = Application.Max(D.KEYS) To Application.Min(D.KEYS) Step -1
  44.             If D.EXISTS(X) Then   '¦r¨åª«¥ó¦³³o­ÓKEY(ÃöÁä¦r)
  45.                 If .Cells(1, C) = "" Then .Cells(1, C) = C - 1
  46.                 .Cells(R, C) = X
  47.                 .Cells(R, C).Interior.ColorIndex = 40
  48.             
  49.                 .Cells(R + 1, C) = D(X)
  50.                 C = C + 1
  51.             End If
  52.         Next
  53.     End With
  54.     D.RemoveAll   '­«³],¦r¨åª«¥ó(¬ö¿ý¦¨¥æ»ùªº¤½¦¡ªº­È)
  55.    
  56.    '³o¦æªºµ{¦¡½X¥i§R°£¤W¤@¤ÀÄÁªº¸ê®Æ,¥[³tµ{¦¡ªº¹B¦æ
  57.     Range("A" & Rows.Count).End(xlUp).CurrentRegion.Offset(1) = ""    '¦p­n«O¯d¥iµù¸Ñ±¼¤£¥²°õ¦æ
  58.     Application.EnableEvents = True
  59. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 40# c_c_lai


    ¥i¥H°O¿ý¡A¦ý¤£¥i²Î­p¡AC¤jÁÂÁ¡A§Ú·Q§ÚÁÙ¬O§ï¥ÎAPI+EXCELªº¤è¦¡¶i¦æ¦n¤F¡A¤£¥Î¦A¶O¤ß¤F¡A¯uªº«D±`ªºÁÂÁ©p

TOP

¦^´_ 38# ÂŤÑÄR¦À
  1. Sub ²Î­p()        '  L¡BM¡BN¡BO Äæ¦ì²Î­p
  2.     Dim DD As Date
  3.    
  4.     dicStatics
  5.     DD = Format(Now, "yyyy/mm/dd hh:mm")    '  DD = 2016/1/28 ¤W¤È 12:41:00 : Date
  6.     TimeTxt = DD + 1 / 1440                 '  TimeTxt = 2016/1/28 ¤W¤È 12:42:00 : Variant/Date
  7.     Application.OnTime TimeTxt, "²Î­p"      '  ¨C¤@¤ÀÄÁ¦Û°Ê¦A¦¸°õ¦æ¤@¦¸¡C
  8. End Sub

  9. Sub dicStatics()
  10.     Dim txt As String, dic As Object, dic2 As Object, A As Range, sp As Variant

  11.     ' txt = [B2] & Left(CStr(Format([A2], "HH:MM:SS")), 5)
  12.     ' txt = [B2] & Left(CStr([A2]), 5)
  13.     '  MsgBox txt

  14.     Set dic = CreateObject("Scripting.Dictionary")
  15.     Set dic2 = CreateObject("Scripting.Dictionary")

  16.     For Each A In Range([A3], [A3].End(xlDown))
  17.         txt = A.Offset(, 1) & "," & Left(Format(A, "HH:MM:SS"), 5)
  18.         '  dic(txt) = IIf(IsEmpty(dic(txt)), A.Offset(, 4).Value + 1, dic(txt)) + A.Offset(, 4).Value
  19.         '  ¦b IsEmpty(dic(txt)) §PÂ_®É¡A dic(txt) ·|¦Û°Ê¥ý½á¤©¤@¦¸¤§ A.Offset(, 4).Value ­È¡AµM«á¦A¦¸
  20.         '  Assign ¤@¦¸ªº A.Offset(, 4).Value ­È¡A ¦p A.Offset(, 4).Value = -1¡A«hµ²ªG·|Åܦ¨ -2¡C
  21.         '  ¬O¬G§ï¦¨¦p¤U¤è¦¡¡Aª½±µ½á¤©¤@¦¸¤§ A.Offset(, 4).Value ­È¡A«hµ²ªG«K·|Åܦ¨ -1 (ªì©l­È³]©w)¡C
  22.         dic(txt) = dic(txt) + A.Offset(, 4).Value       '  ¦¸
  23.         dic2(txt) = dic2(txt) + A.Offset(, 2).Value     '  ¶q
  24.     Next
  25.    
  26.     [M3].Resize(UBound(dic.Keys) + 1) = Application.Transpose(dic.Keys)                '  ¯Á¤Þ­È´N¬O Keys
  27.     [N3].Resize(UBound(dic.Keys) + 1) = Application.Transpose(dic.Items)               '  ¸ê®Æ¤º®e´N¬O Items
  28.     [O3].Resize(UBound(dic2.Keys) + 1) = Application.Transpose(dic2.Items)               '  ¸ê®Æ¤º®e´N¬O Items
  29.    
  30.     With [M3].Resize(UBound(dic.Keys) + 1, 3)        '  Range("M3:M" & [M3].End(xlDown).Row)
  31.         .Cells.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo    '  xlAscending
  32.     End With
  33.    
  34.     For Each A In Range([M3], [M3].End(xlDown))
  35.         sp = Split(A, ",")
  36.         A.Offset(, -1) = sp(0)
  37.         A = sp(1)
  38.     Next
  39. End Sub
½Æ»s¥N½X

TOP

¦^´_ 38# ÂŤÑÄR¦À
¨º§A¥Î§Ú¥Ø«e¤W¶ÇªºÀɮרӰµ´ú¸Õ¬Ý¬Ý¡C
´ú¸Õ§¹«á§i¶D§Ú¤@Ánµ²ªG¡C
§Ú¥ý§â­ã´£³¡ªLª©¤j¤À¨Éªº¥\¯à§ï¬° ²Î­pA()¡A
¥ý¤£¤©°õ¦æ¡A¦Ó¥h°õ¦æ§Ú¼W¥[¤§´ú¸Õ¼Ò²Õ
²Î­p() ->dicStatics §AÆ[¹î¬Ý¬Ý¶i¦æ¶¶ºZ§_¡H
©ú²ÓÅÜ°Ê°O¿ý.rar (192.18 KB)

TOP

¦^´_ 37# c_c_lai


    ´ú¸ÕC¤jªºÀɮ׫á¡Aµo²{¥i¯à°õ¦æ¤Ó¦hªF¦è¡ADDE³£¤£¤Ó·|¸õ°Ê¤F¡A¤§«e1¬í¸õ7-8¦¸¡A²{¦b2-3¬í¸õ°Ê¤@¦¸

TOP

¦^´_ 36# ÂŤÑÄR¦À
³Ìªñ¦³ÂI¨Æ¯ÔÀÁ¤F¡C
§A¦b #10 ¸Ìªº»¡©ú¡A­nªº¬O¡H

TOP

        ÀR«ä¦Û¦b : ¡i¦æµ½­n¤Î®É¡j¦æµ½­n¤Î®É¡A¥\¼w­n«ùÄò¡C¦p¿N¶}¤ô¤@¯ë¡A¥¼¿N¶}¤§«e¤d¸U¤£­n°±º¶¤õ­Ô¡A§_«h­«¨Ó´N¤Ó¶O¨Æ¤F¡C
ªð¦^¦Cªí ¤W¤@¥DÃD