|
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Or Target.Row < 4 Then Exit Sub
For r = [B65536].End(xlUp).Row To 4 Step -1
If Cells(r, "B") <> "" Then
m = Application.CountA(Range("B4:B" & r))
Cells(r, "B").Offset(0, -1) = m 'Cells(r, "B").Offset(0, -1) = n + 464907开始的序号
Else
Cells(r, "B").EntireRow.ClearContents
End If
Next
[B65536].End(xlUp).Offset(1, 0).Resize(65536 - [B65536].End(xlUp).Row, 1).EntireRow.ClearContents
LastRow = ActiveSheet.UsedRange.Rows.Count '删除空白的行
LastRow = LastRow + ActiveSheet.UsedRange.Row - 1
For l = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(l)) = 0 Then Rows(l).Delete
Next l
If Target.Count > 7 Then Exit Sub '选择的单元格计数大于1就退出程序
If Target.Column <> 7 Or Target.Row < 4 Then Exit Sub ' 选择的单元格列值不等于1或者第一个单元格的行号小于4就退出程序
If Target = "" Then Exit Sub '选择的单元格计数为空就退出程序
Dim n&, cs, nl, xb$
n = Len(Target.Value)
If n = 18 Then
cs = DateSerial(Mid(Target.Value, 7, 4), Mid(Target.Value, 11, 2), Mid(Target.Value, 13, 2))
nl = DateDiff("yyyy", cs, Date)
xb = Mid(Target.Value, 17, 1)
If xb Mod 2 = 0 Then
Target.Offset(0, -4) = "女" '表示target单元格向下0行,向右-4行的单元格
Else
Target.Offset(0, -4) = "男"
End If
Target.Offset(0, -3) = nl
Else
MsgBox "不是有效身份证号码。"
End If
End Sub
以上空格行上下单独运行没有问题,合起来后面一段就不能运行,请高手帮忙修改,谢谢
|
|