Excel使用VBA破解工作表/工作簿密码
网上下载了工作簿，发现居然有密码!xxoo，既然放网上干嘛要加密码啊?!后来网上找到使用VBA破解工作表密码的方法，拿来分享。
首先，尝试打开工作簿时，提示有密码：
使用快捷键Ctrl+F11键，打开VBA编辑界面，点击插入菜单下的子菜单模块：
在模块编辑器中输入以下代码：
Option Explicit
Public Sub AllInternalPasswords()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/ejc/）"Norman Harker and JE MCGImpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/ejc/）Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.Excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformaTulaoshi.comtion, HEADER
Else
On Error Resume Next
Do 'dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
With ActiveWorkbook
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If .ProtectStructure = False And _
.ProtectWindows = False Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
ShTag = ShTag Or w1.ProtectContents
Next w1
If ShTag Then
For Each w1 In Worksheets
With w1
If .ProtectContents Then
On Error Resume Next
Do 'Dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If Not .ProtectContents Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub
点击运行：
破解过程需要几分钟，有几次对话框弹出，都是英文的，留意对话框中如下内容：
标注部分即为密码。虽然不是原始密码，但是用这个密码照样可以打开工作簿的。
Excel+记事本批量新建文件夹
有时候我们需要根据一堆人名或者身份证号批量新建文件夹或者文件，本节教程均适用。原理，利用Excel的基本功能批量生成CMD命令，然后粘贴保存到bat文件中，双击执行即可。
1、打开excel表格：
2、在2B单元格输入：="MD "&A2
熟悉MD命令的都知道这个命令是新建文件夹的命令。
3、选中2B单元格，向下拖拉复制至最后一行：
这样就得到了很多个MD命令。
4、将上图中B列中的内容全部复制到记事本中：
5、将记事本保存后，改扩展名为bat：
6、改完后双击执行即可。试试看，效果不错吧?
利用Excel宏功能批量取消超级链接的方法
最近整理一个Excel文档，里面有很多超级链接需要取消删除，一个一个取消实在是太费时费力了，于是找到一个使用宏功能批量取消删除超级链接的方法。
①使用Excel快捷键 Ctrl + F8 ，在弹m.tulaoshi.com出的宏窗口的宏名中输入一个名称，然后单击创建按钮;
此时，会弹出一个 Microsoft Visual Basic 窗口;
②在 Sub 和 End Sub 之间输入 Cells.Hyperlinks.Delete ，然后单击保存按钮，将其保存起来(保存到任意地方都可以);
③回到刚才的表格中，单击菜单栏的工具，在下来列表中选择宏里面的宏;
④在弹出的宏窗口中点击执行按钮即可批量去掉Excel表格中所有的超级链接。
看看是不是所有的超级链接都已经删除干净了呢?
Excel2013制作随机抽奖系统
简单的制作方法。
1.首先要打开我们的Excel2013表格，制作出本次参与抽奖的名单。
(点小图看大图)
2.然后再在F2单元格中输入 =INDIRECT("d"&INT(RAND()*13+2))
(点小图看大图)
3. 公式的意义是：int函数返回一个2-14的随机整数，和d串联就会返回D2：D14之间的随机单元格，最后，indirect会返回随机单元格里面的姓名。
回车按下，得到一个人员的名字：孙天乐。
(点小图看大图)
4. 选中从A到D，单击菜单栏--条件格式--新建规则选项。
(点小图看大图)
5. 选择最后一个规则类型，途中已用红线标出来了，使用公式确定要设置格式的单元格，输入公式：=$D1=$F$2,点击格式按钮。
(点小图看大图)
6. 弹出一个新建格式规则框如下图，可以置单元格格式，也就是中奖人员在名单册中的现实方式，与其他人进行区分。
(点小图看大图)
7. 确定完了后再看看我们的表格的最终效果。
(点小图看大图)
我们www.ew8.cn 郑州易网科技有限公司的孙天乐是我们的获奖者，很明确的表示出来了吧?嗯哼!这个Excel2013表格制作的抽奖系统不错吧?哦，最后告诉你按下F9键刷新，就会重新抽奖。好了blue1000今天讲的这个利用Excel2013去制作一个随机抽奖的系统是不能够作假的，没有猫腻的公平的随机抽奖系统，你要是需要认为控制的抽奖呢，且听有时间再告诉你。
Excel中列数据的拆分的方法
大家都知道Excel中列的拆分，但有时候我们却不只需要这个，我们还需要将列中的数据进行拆分。比如，将123456，拆成两列，一列是123，另一列是456。我们来看看excel是如何将列中数据进行拆分的。
①首先，我们在Excel表格中选中需要拆分的列;
②然后，单击菜单栏的数据，在下拉列表中选择分列命令;
③此时，需要3个步骤来完成数据在表格中的拆分，文本分列向导 - 3 步骤之 1，我们只需选择默认的分割符号再单击下面的下一步按钮;
④然后，继续在文本分列向导 - 3 步骤之 2下面的分隔符号中勾选Tab 键、空格和连续分隔符号视为单个处理。(现在我们可以在数据预览中看到拆分的效果)最后单击下一步;
⑤最后一个步骤，我们单击完成就可以了。
拆分好的表格效果如下图所示：
对Excel2013合并单元格如何排序的方法
如下图所示，A列是合并单元格，而且都是合并了3个单元格，默认情况下，合并单元格是不能进行排序操作的。那么就没有办法了么?blue1000教你。
①启动Excel2013，看到下面的表格数据，首先选中A2：A13区域，鼠标移动到右下角，出现+号填充柄。
②向右填充，选择仅填充www.Tulaoshi.com格式。我们不是要改变其内容，只是要个格式而已。
③单击长沙单元格，点击菜单栏--数据--升序排列按钮。
④这样A列就按照首字母顺序进行了排列，但是B、C列还没有取消单元格合并，选择这区域，单击开始--取消单元格合并。
⑤最终完成，大家可以按照这个方法对合并单元格进行排序了。
Excel2007隔列求和的运算方法
今天的办公教程是教大家Excel2007隔列求和的运算方法。关于求和最简单的方法莫过于把单元格相加，但是最麻烦的也是这种方法。今天教大家的是用公式求和，用公式求和也许大家都会，今天要讲的是隔列求和的公式运算方法。
公式说明
首先我们先胶带一下公式的意义。由于每隔2列求和，也就是将2、6、9、12列的数据求和，所以先用mod函数来判断列号与3相除的余数是不是为0，是的话，就返回TRUE(1)，否则就返回FALSE(0)，最后再用Sumproduct函数返回与数组A2：L2的乘积之和。
①打开含有数据的Excel2007表格，一年之中十二个月的数据情况，我们要隔2列进行求和，例如三、六、九、十二，说起求和，函数公式必不可少，我们不要怕这些，在M2单元格输入下图中的公式，进行隔2列求和。
②输完，回车得到结果223，双击该单元格右下角的填充柄，自动将余下的数据计算出来。
③下面，我们来验证一下函数公式计算的对不对，将第9行三、六、九、十二4个月份的数据以黄色颜色，按住Ctrl键选中，在下方的状态栏中可以查看到求和结果为259，证明我们的公式计算准确无误。
④公式中的参数3，表示是隔2列，隔2列是3，隔3列就是4，隔4列就是5，以此类推。
