| ©«¤l967 ¥DÃD0 ºëµØ0 ¿n¤À1001 ÂI¦W0  §@·~¨t²ÎWIN XP ³nÅ骩¥»OFFICE 2003 ¾\ŪÅv50 ©Ê§O¨k ¨Ó¦Û¥x¥_ µù¥U®É¶¡2010-11-29 ³Ì«áµn¿ý2022-5-17 
  
 | 
                
| ¥»©«³Ì«á¥Ñ register313 ©ó 2012-5-25 12:14 ½s¿è 
 ¦^´_ 4# freeffly
 ½Æ»s¥N½XSub ¶R()
With Sheets("100000¥«¥[Åv¤é½u")
  .[S2:Y65536] = ""
  For I = 2 To Range("A65536").End(xlUp).Row
    X = .Cells(I, "E") > .Cells(I, "H") And .Cells(I, "H") > .Cells(I, "I") And .Cells(I, "H") <> "" And .Cells(I, "I") <> ""
    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") <> ""
    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") <> ""
    If (X And Not XU) Or (X And Not XD) Then Cells(I, "S") = .Cells(I, "E")
  Next
  Dim Ar()
  C = 1
  T = Application.CountA([S:S])
  ReDim Ar(1 To T, 1 To 3)
  For Each S In .Range("S2:S" & .[A2].End(xlDown).Row).SpecialCells(xlCellTypeConstants)
    Ar(C, 1) = Format(S.Offset(0, -18), "yyyy/m/d")
    Ar(C, 2) = S
    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) <> ""
    If C > 1 And Not XU Then
      If Ar(C - 1, 3) = 0 Then Ar(C, 3) = Ar(C, 2) - Ar(C - 1, 2)
    End If
    C = C + 1
  Next
  .[W2].Resize(UBound(Ar), 3) = Ar
End With
End Sub
 | 
 |