­ã´£³¡ªL

Sub TEST()
Dim i&, R&, C&, xD, xArea As Range, Arr, xR As Range, X&, Y&, Z%
C = [IV2].End(xlToLeft).Column
R = [B65536].End(xlUp).Row
Set xD = CreateObject("Scripting.Dictionary")
For i = 4 To R Step 4:  xD(Cells(i, 1) & "") = i - 3: Next i¡@¡@'¨ú±o¡eTester No¡fªº¡e¦C¦ì¡f
For i = 3 To C:  xD(Format(Cells(2, i), "yyyy-mm-dd")) = i - 2: Next i¡@'¨ú±o¤é´Áªº¡eÄæ¦ì¡f
Set xArea = [C4].Resize(R - 3, C - 2)¡@'²Î­p¼Æ­È°Ï
xArea.ClearContents: Arr = xArea¡@'²M°£²Î­p¡A¥HArr¥N¥X
¡@
For Each xR In Range([summary!D3], [summary!D65536].End(xlUp))
¡@¡@X = xD(xR.Value)¡@'¡eTester No¡fªº¡e¦C¦ì¡f
¡@¡@Y = xD(Format(xR(1, 3), "yyyy-mm-dd"))¡@'¤é´Áªº¡eÄæ¦ì¡f
¡@¡@If X = 0 Or Y = 0 Then GoTo 101
¡@¡@Z = Int(Hour(xR(1, 3)) / 8)¡@'¦­¤È±ß®É¬q­pºâ
¡@¡@Arr(X + Z, Y) = Arr(X + Z, Y) + 1¡@'²Ö­p®É¬q¦¸¼Æ
¡@¡@Arr(X + 3, Y) = Arr(X + 3, Y) + 1¡@'²Ö­p·í¤é¦¸¼Æ
101: Next
xArea = Arr
End Sub

yen956

½Ð¦Û¦æ´ú¸Õ¬Ý¬Ý!!(¸ê®Æ¤Ó¦h)

1. Private Sub CommandButton1_Click()
   
2.    Dim LastR As Integer, I As Integer
   
3.    Dim Rng As Range, fAddr As String
   
4.    Dim Col1 As Integer, Off1 As Integer, H1 As Integer
   
5.    LastR = [D65536].End(xlUp).Row
   
6.    [F2:AI73] = ""
   
7.    For I = 2 To LastR Step 4
   
8.        Set Rng = [A:A].Find(Cells(I, 4), Lookat:=xlWhole)  'ÄæA ¤¤´M§äTesterNo
   
9.        If Not Rng Is Nothing Then
   
10.            fAddr = Rng.Address
    
11.            Do
    
12.                Col1 = Day(Rng.Offset(0, 1)) + 5
    
13.                H1 = Hour(Rng.Offset(0, 1))
    
14.                Off1 = IIf(H1 < 16, 1, 2)
    
15.                If H1 < 8 Then Off1 = 0
    
16.                Cells(I + Off1, Col1) = Cells(I + Off1, Col1) + 1
    
17.                Cells(I + 3, Col1) = Cells(I + 3, Col1) + 1
    
18.                Set Rng = [A:A].FindNext(Rng)   '´M§ä¤U¤@­ÓTesterNo
    
19.            Loop Until fAddr = Rng.Address      'ª½¨ì¤U¤@­ÓTesterNoªº¦ì¸m=²Ä¤@­ÓTesterNoªº¦ì¸m
    
20.        End If
    
21.    Next
    
22. End Sub

½Æ»s¥N½X

¤U¸ü (56.85 KB)

2015-11-29 17:54

jeff5424

¦^´_ 9# hcm19522
·PÁÂhcm19522¤j¤jªºÀ°¦£,§Ú¦b´ú¸Õ¥¿±`.....ÁÂÁÂ

jeff5424

¦^´_ 12# yen956
yen956 ¤j¤j,§Ú´ú¸Õ«á¤£¯à¥Î¥¨¶°/VBA,¥i¥H³Â·Ð¤j¤jµ¹§Ú­ì©lÀɶÜ....ÁÂÁÂ

yen956

¦^´_ 14# jeff5424
¥i¯à¬O¥¨¶°¦w¥þ©Êªº°ÝÃD,
±N¥¨¶°¦w¥þ©Ê½Õ§C´N¥i¥H¤F.

¤U¸ü (162.47 KB)

2015-11-30 08:11

jeff5424

¦^´_ 15# yen956
yen956 ¤j¤j,§Ú´ú¸Õ¥X²{err(¦p¹Ï©Ò¥Ü),¥i¥H±NexcelÀɶÜ....ÁÂÁÂ

yen956

¦^´_ 16# jeff5424
ÂÂVBA Code¨S§R°®²b!!
±N²Ä¤@¦C§R°£§Y¥i.

http://www.mediafire.com/download/8t334h19m3lr82m/%E7%B4%AF%E8%A8%88%E6%AC%A1%E6%95%B8.rar

jeff5424

¦^´_ 17# yen956
·PÁÂyen956¤j¤j....´ú¸ÕOK.....ÁÂÁÂ