实用excel宏代码(精华版)

非常实用excel宏代码

代码功能包含：

显示所有隐藏工作表，按指定列拆分工作表，将一个工作簿内的多个工作表拆分为一个个独立的工作簿，在工作簿打开的状态下直接重命名活动工作簿，工作表保护密码破解，一次性关闭所有工作簿，将所选单元格数值单位转换为万显示，一次性提取所有工作表名称等

--------------------------------------------------

Sub 显示所有隐藏工作表()

For Each St In Sheets

If St.Visible = False Then St.Visible = True Next

End Sub

-------------------------------------------

Sub 按指定列拆分工作表()

Dim i%, m%, h$

h =

Range("a1").Select

m = InputBox("请输入列数")

Columns(m).Copy

Worksheets.Add After:=Sheets(Sheets.Count)

= "B"

Range("A1").Select

ActiveSheet.Paste

Range("A:A").RemoveDuplicates (1)

Sheets("B").Visible = False

For i = 2 To Application.WorksheetFunction.CountA(Sheets("B").Range(" A:A"))

Sheets(h).Activate

edRange.AutoFilter Field:=m, Criteria1:=Sheets("B").Cells(i, 1)

Sheets(h).UsedRange.Copy

Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Paste

= Sheets("B").Cells(i, 1)

Sheets(h).Select

Next

Selection.AutoFilter

Application.DisplayAlerts = False

Sheets("B").Delete

Application.DisplayAlerts = True

End Sub

----------------------------------------

Sub 重命名活动工作簿()

'如果利用DIR提取的活动工作簿的名称长度为0(即未保存)，那么提示用户，然后退出程序

If Len(Dir(ActiveWorkbook.FullName)) = 0 Then MsgBox "请先保存工作簿", vbOKOnly, "友情提示": Exit Sub Dim 原名称As String, 新名称As String, 后缀名As String, 路径As String '声明变量原名称= '提取活动工作簿名称

后缀名= StrReverse(Mid(StrReverse(原名称), 1, InStr(StrReverse(原名称), "."))) '提取活动工作簿的后缀名

新名称= Application.InputBox("请输入文件名", "新名称", Replace(原名称, 后缀名, ""), , , , , 2) '弹出输入框让用户输入新的名称

If 新名称= "False" Then End '如果选择了取消键则结束过程

路径= Replace(ActiveWorkbook.FullName, 原名称, "") '提取活动工作簿的路径

On Error Resume Next '当有错误时继续执行

MkDir "C:\" & 新名称'在C盘创建一个同名的文件夹(测试字符串能否作为文件名称)

If Err <> 0 Then '如果有错误

MsgBox "您输入的字符不允许作为文件名，请重新输入！", vbOKOnly, "友情提示" '提示Else

'否则

RmDir "C:\" & 新名称'删除创建的文件夹

ActiveWorkbook.SaveAs 路径& 新名称& 后缀名'将活动工作簿另存为指定的名称(与原文件相同路径下)

Kill 路径& 原名称'删除原来的文件

End If

End Sub

---------------------------------------------------

Public Sub 工作表保护密码破解()

Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ "作者:McCormick JE McGimpsey "

Const HEADER As String = "工作表保护密码破解"

Const VERSION As String = DBLSPACE & "版本Version 1.1.1"

Const REPBACK As String = DBLSPACE & ""

Const ZHENGLI As String = DBLSPACE & " hfhzi3—戊冥整理"

Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _

& DBLSPACE & "注意：不要用在不当地方，要尊重他人的劳动成果！"

Const MSGNOPWORDS1 As String = "该文件工作表中没有加密"

Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2"

Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!"

Const MSGPWORDFOUND1 As String = "密码重新组合为:"