- ©«¤l
- 967
- ¥DÃD
- 0
- ºëµØ
- 0
- ¿n¤À
- 1001
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN XP
- ³nÅ骩¥»
- OFFICE 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-11-29
- ³Ì«áµn¿ý
- 2022-5-17
|
¥»©«³Ì«á¥Ñ register313 ©ó 2012-5-25 12:14 ½s¿è
¦^´_ 4# freeffly - Sub ¶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
½Æ»s¥N½X |
|