Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
Dim I As Long
Dim J As Long
Application.ScreenUpdating = False
Call LASTCell(J)
For I = 2 To J
If Len(Sheets("SHEET1").Range("C" & I)) = 18 Or Right(Sheets("SHEET1").Range("C" & I), 1) = "N" Then
Sheets("SHEET1").Range("D" & I) = "新"
End If
If Len(Sheets("SHEET1").Range("C" & I)) = 15 Then
Sheets("SHEET1").Range("D" & I) = "舊"
If Sheets("SHEET1").Range("A" & I) <> Sheets("SHEET1").Range("A" & I + 1) Then
Call INSERT(I)
Sheets("SHEET1").Range("A" & I + 1 & ":D" & I + 1).Value = Sheets("SHEET1").Range("A" & I & ":D" & I).Value
Sheets("SHEET1").Range("C" & I + 1) = Left(Sheets("SHEET1").Range("C" & I), 6) & "19" & Right(Sheets("SHEET1").Range("C" & I), 9) & "N"
Sheets("SHEET1").Range("D" & I + 1) = "新"
I = I + 1
J = J + 1
End If
End If
Next
End If
End Sub
Sub LASTCell(J As Long)
With Sheets("SHEET1").Range("A:A")
Set X = .Find(What:="", After:=.Cells(.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not X Is Nothing Then J = X.Row + 2
End With
End Sub
Sub INSERT(I As Long)
'
Rows(I + 1 & ":" & I + 1).Select
Selection.INSERT Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub作者: der寶寶 時間: 2014-12-23 23:03
