模拟“自动更正”,助你提高效率

来源:百度文库 编辑:神马文学网 时间:2024/03/29 10:38:37
   每年年底,单位总有很多文件要装订归档,首页“卷内目录”中需录入不少汉字,如何提速增效呢?利用Excel菜单“工具”→“自动更正”功能,虽然也可以通过添加一些缩写字母替换为指定的汉字短语,以此来提高汉字的输入速度。可是,如果换一台电脑操作,又得重新添加“自动更正”的内容,在提高速度的同时也带来一些不方便。为此,本人通过编写VBA代码,只要在“发文单位”栏输入首字母缩写,“发文号”栏只输入文号的数字部分,“文件起号”、“文件讫号”、“文件起止张号”三栏不必输入,由公式自动产生,大大提高了效率。

1、要求的“卷内目录”格式(打印时可把单元格底纹去掉)

 

2、在F列与G列之间插入“文件起号”、“文件讫号”两列

 

注: G:I列黄色底纹部分由公式产生,不必输入。公式中用到ISBLANK函数。

如:I3单元格公式为:=IF(ISBLANK(F3),0,G3 & "-" & H3)

3、在工作表某区域设置以下缩写、发文单位、文号前缀对应内容,输入完成后,可把这4列隐藏。

 

4、实际应用中,输入“发文单位”时,只要键入首字母缩写。如:江苏省政府,输入SZF;省交通厅、省公安厅输入JTT、GATSJTT、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()

    '指定范围(输入数据区域)为B3F300

    '敲回车键向右移动,到指定范围最右侧一列时,

    '再敲回车键,移到指定范围下一行的最左侧

    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

End Sub    附件下载:Box.net  |  SkyDrive