freeffly

¦^´_ 3# Hsieh
ª©¥Dªþ¤W­ì©l¤½¦¡
­è¬Ý¤@¤Uµ²ªGÁÙ¬O¸ò§Ú§Ë±o¤@¼Ë
¬O§Ú¤½¦¡¦³¿ù¶Ü
­è¬Ý¤½¦¡À³¸Ó¬O¸ò§Aªº¤@¼Ë

   

100000.rar (559.76 KB)

¤U¸ü¦¸¼Æ: 15

2012-5-25 11:50

register313

¦^´_ 4# freeffly

1. Sub ¶R()
   
2. With Sheets("100000¥«¥[Åv¤é½u")
   
3.   .[S2:Y65536] = ""
   
4.   For I = 2 To Range("A65536").End(xlUp).Row
   
5.     X = .Cells(I, "E") > .Cells(I, "H") And .Cells(I, "H") > .Cells(I, "I") And .Cells(I, "H") <> "" And .Cells(I, "I") <> ""
   
6.     XU = .Cells(I - 1, "E") > .Cells(I - 1, "H") And .Cells(I - 1, "H") > .Cells(I - 1, "I") And .Cells(I - 1, "H") <> "" And .Cells(I - 1, "I") <> ""
   
7.     XD = .Cells(I + 1, "E") > .Cells(I + 1, "H") And .Cells(I + 1, "H") > .Cells(I + 1, "I") And .Cells(I + 1, "H") <> "" And .Cells(I + 1, "I") <> ""
   
8.     If (X And Not XU) Or (X And Not XD) Then Cells(I, "S") = .Cells(I, "E")
   
9.   Next
   
10.   Dim Ar()
    
11.   C = 1
    
12.   T = Application.CountA([S:S])
    
13.   ReDim Ar(1 To T, 1 To 3)
    
14.   For Each S In .Range("S2:S" & .[A2].End(xlDown).Row).SpecialCells(xlCellTypeConstants)
    
15.     Ar(C, 1) = Format(S.Offset(0, -18), "yyyy/m/d")
    
16.     Ar(C, 2) = S
    
17.     XU = S.Offset(1, -14) > S.Offset(1, -11) And S.Offset(1, -11) > S.Offset(1, -10) And S.Offset(1, -11) <> "" And S.Offset(1, -10) <> ""
    
18.     If C > 1 And Not XU Then
    
19.       If Ar(C - 1, 3) = 0 Then Ar(C, 3) = Ar(C, 2) - Ar(C - 1, 2)
    
20.     End If
    
21.     C = C + 1
    
22.   Next
    
23.   .[W2].Resize(UBound(Ar), 3) = Ar
    
24. End With
    
25. End Sub

½Æ»s¥N½X

freeffly

¦^´_ 2# register313


    ¤j¤jredim«á­±´N¬Ý¤£¤ÓÀ´
   ÁöµM¦³¸ÕµÛ¥h¶]µ²ªG¦ý¤£ª¾¹D¬°¤°»ò¥i¥H¨º¼Ë¥Xµ²ªG
   ³oÃä¥i¯à§ÚÁÙ­n¦A¬ã¨s

   ¤j¤jªº¤è¦¡¬O¥Î§Ú§Ë¥X¨Óªºµ²ªG¥h¶]UÁÙ¦³W:YÄæ
   ½Ð°Ý¥i¥H¤£¥ý¶]SÄ檽±µÅýSÄ檺µ²ªGµ¥©óUÄæ¶Ü?

Hsieh

¦^´_ 1# freeffly

SÄ楫¦¬½L»ù>10§¡¥B>20§¡±o¥Xªºµ²ªG
¦ý¬O¥H¤½¦¡§PÂ_¥X¨Ó¦n¹³¤£¤Ó¬Û¦P
¹Ï¤¤ÂŮس¡¤ÀSÄæ»PVÄ榳©Ò¥X¤J
VÄæ¬õ¦â¥Nªí²Å¦X±ø¥ó"¥«¦¬½L»ù>10§¡¥B>20§¡"
½Ð»¡©ú§PÂ_ÅÞ¿èÀ³¦óªÌ¥¿½T?

¤U¸ü (26.13 KB)

2012-5-25 08:37

register313

¦^´_ 1# freeffly

1. Sub ¶R()
   
2. With Sheets("100000¥«¥[Åv¤é½u")
   
3.   Union(.[U:U], .[W:Y]) = ""
   
4.   For I = 2 To Range("A65536").End(xlUp).Row
   
5.     .Cells(I, "S").End(xlDown).Offset(, 2) = .Cells(I, "S").End(xlDown)
   
6.   Next
   
7.   Dim Ar()
   
8.   S = 1
   
9.   C = Application.CountA([U:U])
   
10.   ReDim Ar(1 To C, 1 To 3)
    
11.   For Each U In .Range("U2:U" & .[A2].End(xlDown).Row).SpecialCells(xlCellTypeConstants)
    
12.     Ar(S, 1) = Format(U.Offset(0, -20), "yyyy/m/d")
    
13.     Ar(S, 2) = U
    
14.     If S > 1 And U.Offset(1, -2) = "" Then
    
15.       If Ar(S - 1, 3) = 0 Then Ar(S, 3) = Ar(S, 2) - Ar(S - 1, 2)
    
16.     End If
    
17.     S = S + 1
    
18.   Next
    
19.   .[W2].Resize(UBound(Ar), 3) = Ar
    
20. End With
    
21. End Sub

½Æ»s¥N½X