模拟“自动更正”,助你提高效率
来源:百度文库 编辑:神马文学网 时间:2024/03/29 10:38:37
1、要求的“卷内目录”格式(打印时可把单元格底纹去掉)
2、在F列与G列之间插入“文件起号”、“文件讫号”两列
注: G:I列黄色底纹部分由公式产生,不必输入。公式中用到ISBLANK函数。
如:I3单元格公式为:=IF(ISBLANK(F3),0,G3 & "-" & H3)
3、在工作表某区域设置以下缩写、发文单位、文号前缀对应内容,输入完成后,可把这4列隐藏。
4、实际应用中,输入“发文单位”时,只要键入首字母缩写。如:江苏省政府,输入SZF;省交通厅、省公安厅输入JTT、GAT或SJTT、SGAT(顿号分隔)。
“发文号”栏只要输入文号数字部分即可,系统会自动进行转换。
5、转换后的结果如下:
代码如下:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 And Target.Column <> 5 Then End '仅替换第2列、第5列
Application.EnableEvents = False
Dim topCel As Range, bottomCel As Range, sourceRange As Range, _
targetRange As Range, i As Integer, numofRows As Integer, _
iAt As Integer, iLen As Integer, sText As String
If Target.Column = 2 Then
Set topCel = Range("M3")
Set bottomCel = Range("M65536").End(xlUp)
Else
Set topCel = Range("N3")
Set bottomCel = Range("N65536").End(xlUp)
End If
If topCel.Row > bottomCel.Row Then End
Set sourceRange = Range(topCel, bottomCel)
numofRows = sourceRange.Rows.Count
If Target.Column = 2 Then
sText = UCase(Target) '小写字母转为大写,转为小写LCase
Else
sText = Target.Offset(0, -3).Value
If IsError(Application.Search("、", sText)) Then
iAt = 0
Else
iAt = Application.Search("、", sText)
End If
'多个部门联合发文的,部门之间用顿号分隔
If iAt > 0 Then
sText = Left(sText, iAt - 1)
End If
End If
For i = 1 To numofRows
If sText Like "*" & sourceRange(i) & "*" Then
If Target.Column = 5 Then
sText = sourceRange(i).Offset(0, 1)
Exit For
'默认由第一个部门编文号
End If
'iAt = Application.WorksheetFunction.Search(sourceRange(i), sText)
iAt = Application.Search(sourceRange(i), sText)
iLen = Len(sourceRange(i))
sText = Application.Replace(sText, iAt, iLen, sourceRange(i).Offset(0, 1))
End If
Next
If Target <> sText Then
If Target.Column = 2 Then
Target = sText
Else
Target = sText & [P3] & Target
If Right(Target, 1) <> "号" Then Target = Target & "号"
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{ENTER}", "HuiChe"
Application.OnKey "~", "HuiChe"
End Sub
Private Sub Worksheet_Deactivate()
Application.OnKey "~" '切换到其它工作表时,取消ENTER键响应的事件
End Sub
模块代码:
Sub HuiChe()
'指定范围(输入数据区域)为B3:F300
'敲回车键向右移动,到指定范围最右侧一列时,
'再敲回车键,移到指定范围下一行的最左侧
If ActiveCell.Row >= 3 And ActiveCell.Row <= 300 And _
ActiveCell.Column >= 2 And ActiveCell.Column <= 6 Then
If ActiveCell.Column = 6 Then
ActiveCell.Offset(1, -4).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Else
ActiveCell.Offset(0, 1).Select
End If