Excel使用VBA破解工作表/工作簿密码

寻Q757856333挚

寻Q757856333挚

2016-04-01 01:28

get新技能是需要付出行动的,即使看得再多也还是要动手试一试。今天图老师小编跟大家分享的是Excel使用VBA破解工作表/工作簿密码,一起来学习了解下吧!

Excel使用VBA破解工作表/工作簿密码

   网上下载了工作簿,发现居然有密码!xxoo,既然放网上干嘛要加密码啊?!后来网上找到使用VBA破解工作表密码的方法,拿来分享。

  首先,尝试打开工作簿时,提示有密码:

Excel使用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" & _

  "Norman Harker and JE MCGImpsey"

  Const HEADER As String = "AllInternalPasswords User Message"

  Const VERSION As String = DBLSPACE

  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

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  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

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  Next: Next: Next: Next: Next: Next

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  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

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  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

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  Next: Next: Next: Next: Next: Next

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/ejc/)

  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表格:

Excel+记事本批量新建文件夹 图老师

  2、在2B单元格输入:="MD "&A2

  熟悉MD命令的都知道这个命令是新建文件夹的命令。

  3、选中2B单元格,向下拖拉复制至最后一行:

  这样就得到了很多个MD命令。

  4、将上图中B列中的内容全部复制到记事本中:

  5、将记事本保存后,改扩展名为bat:

  6、改完后双击执行即可。试试看,效果不错吧?

利用Excel宏功能批量取消超级链接的方法

   最近整理一个Excel文档,里面有很多超级链接需要取消删除,一个一个取消实在是太费时费力了,于是找到一个使用宏功能批量取消删除超级链接的方法。

  ①使用Excel快捷键 Ctrl + F8 ,在弹m.tulaoshi.com出的宏窗口的宏名中输入一个名称,然后单击创建按钮;

利用Excel宏功能批量取消超级链接的方法 图老师

  此时,会弹出一个 Microsoft Visual Basic 窗口;

Microsoft Visual Basic 窗口

  ②在 Sub 和 End Sub 之间输入 Cells.Hyperlinks.Delete ,然后单击保存按钮,将其保存起来(保存到任意地方都可以);

保存宏

  ③回到刚才的表格中,单击菜单栏的工具,在下来列表中选择宏里面的宏;

打开刚才制作的宏

  ④在弹出的宏窗口中点击执行按钮即可批量去掉Excel表格中所有的超级链接。

执行宏
批量取消所有超级链接

  看看是不是所有的超级链接都已经删除干净了呢?

Excel2013制作随机抽奖系统

   简单的制作方法。

  1.首先要打开我们的Excel2013表格,制作出本次参与抽奖的名单。

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表格中选中需要拆分的列;

Excel中列数据的拆分的方法  图老师

  ②然后,单击菜单栏的数据,在下拉列表中选择分列命令;

数据中的分列

  ③此时,需要3个步骤来完成数据在表格中的拆分,文本分列向导 - 3 步骤之 1,我们只需选择默认的分割符号再单击下面的下一步按钮;

文本分列向导

  ④然后,继续在文本分列向导 - 3 步骤之 2下面的分隔符号中勾选Tab 键、空格和连续分隔符号视为单个处理。(现在我们可以在数据预览中看到拆分的效果)最后单击下一步;

下一步

  ⑤最后一个步骤,我们单击完成就可以了。

完成

  拆分好的表格效果如下图所示:

Excel中列数据的拆分

对Excel2013合并单元格如何排序的方法

   如下图所示,A列是合并单元格,而且都是合并了3个单元格,默认情况下,合并单元格是不能进行排序操作的。那么就没有办法了么?blue1000教你。

  ①启动Excel2013,看到下面的表格数据,首先选中A2:A13区域,鼠标移动到右下角,出现+号填充柄。

对Excel2013相同大小的合并单元格进行排序操作

  ②向右填充,选择仅填充www.Tulaoshi.com格式。我们不是要改变其内容,只是要个格式而已。

对Excel2013相同大小的合并单元格进行排序操作

  ③单击长沙单元格,点击菜单栏--数据--升序排列按钮。

对Excel2013相同大小的合并单元格进行排序操作

  ④这样A列就按照首字母顺序进行了排列,但是B、C列还没有取消单元格合并,选择这区域,单击开始--取消单元格合并。

对Excel2013相同大小的合并单元格进行排序操作

  ⑤最终完成,大家可以按照这个方法对合并单元格进行排序了。

对Excel2013相同大小的合并单元格进行排序操作

Excel2007隔列求和的运算方法

   今天的办公教程是教大家Excel2007隔列求和的运算方法。关于求和最简单的方法莫过于把单元格相加,但是最麻烦的也是这种方法。今天教大家的是用公式求和,用公式求和也许大家都会,今天要讲的是隔列求和的公式运算方法。

  公式说明

  首先我们先胶带一下公式的意义。由于每隔2列求和,也就是将2、6、9、12列的数据求和,所以先用mod函数来判断列号与3相除的余数是不是为0,是的话,就返回TRUE(1),否则就返回FALSE(0),最后再用Sumproduct函数返回与数组A2:L2的乘积之和。

  ①打开含有数据的Excel2007表格,一年之中十二个月的数据情况,我们要隔2列进行求和,例如三、六、九、十二,说起求和,函数公式必不可少,我们不要怕这些,在M2单元格输入下图中的公式,进行隔2列求和。

Excel2007隔列求和的运算方法 图老师

  ②输完,回车得到结果223,双击该单元格右下角的填充柄,自动将余下的数据计算出来。

Excel2007中隔N列进行求和如何实现?

  ③下面,我们来验证一下函数公式计算的对不对,将第9行三、六、九、十二4个月份的数据以黄色颜色,按住Ctrl键选中,在下方的状态栏中可以查看到求和结果为259,证明我们的公式计算准确无误。

Excel2007中隔N列进行求和如何实现?

  ④公式中的参数3,表示是隔2列,隔2列是3,隔3列就是4,隔4列就是5,以此类推。

Excel2007中隔N列进行求和如何实现?
展开更多 50%)
分享

猜你喜欢

Excel使用VBA破解工作表/工作簿密码

excel
Excel使用VBA破解工作表/工作簿密码

Excel工作簿与工作表

办公软件
Excel工作簿与工作表

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

在工作簿里面运用Excel工作表

电脑入门
在工作簿里面运用Excel工作表

在工作簿里面选定Excel工作表

电脑入门
在工作簿里面选定Excel工作表

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

在工作簿中选定Excel工作表

办公软件
在工作簿中选定Excel工作表

快速为Excel工作簿创建工作表目录的方法

电脑入门
快速为Excel工作簿创建工作表目录的方法

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

彩云文件搜索出的结果是怎样展示的?

彩云文件搜索出的结果是怎样展示的?

Windows7桌面图标无法拖动的解决方法

Windows7桌面图标无法拖动的解决方法
下拉加载更多内容 ↓