EXCEL方程保护和VBA密码破解

Posted 2023-03-29

2个问题请教Excel高手:

1.如何破解excel visual basic code的密码? 是否必须下载专用破解软件强行破解?
2.在不用macro的情况下,如何保护可写数据单元格里面原有的方程式?

如有人能解答,感谢万分~!
对第一个问题的补充：
我想破解的是 2007VBA的密码，不是excel表格的密码...

对第二个问题的补充：

我知道如何保护公式，锁定单元格就行了~
我想知道的是是否有方法能让我写的公式在“没有锁定”的单元格里不在写入数据时被删除，就好像一个背景公式一样。目前我还没有找到不用宏解决这个问题的方法。

我这样做是因为我有一列用户输入格，这些单元格是同行其他单元格运算的基础（这些格被锁定）。用户可以通过在第一列输入数值来让同行的其他格计算和输出计算结果。

问题在于我想让用户只能在第一列中的一项输入（同时其他项为零）。所以我在第一列每一项中都设有条件公式（IF, VLOOKUP）。但是这些公式在输入的时候会消失...

我把悬赏提高到40分好了，当初没有多少分给大家~

第二种，是A列所有单元格都可以输入，当编辑多于一个单元格时原来的格归零。

直接回答你第二个吧。
右键点中你想保护的单元格-》设置单元格格式-》保护-》勾选锁定和隐藏
再在菜单中工具-》保护-》保护工作表

补充：
用户只能在第一列中的一项输入（同时其他项为零），是指用户只能在某个特定单元格（如A1）输入，还是指在A列的任意一格，但只能编辑一个单元格？

这样就只能用VBA代码实现了。把下面的代码放在Sheet1中（假设你要编辑的页面是Sheet1）：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
If Target.Rows.Count = 1 And Target.Column = 1 And Target.Row <> [IV65536] Then
Application.EnableEvents = False
Cells([IV65536], 1).Formula = "=1+1"
Application.EnableEvents = True
[IV65536] = Target.Row
End If
End Sub
当改变了A列的一个（且只是一个）单元格，并且该单元格不是上次修改的单元格时，触发代码。代码将上一次修改的单元格的公式改为=1+1（你当然可以换成你自己的）。上一次修改的单元格的行号保存在当前表的最右下角单元格中（你需要设置它的初始值，比如为1）
这个代码不一定能直接解决你的问题，但希望对你有所启发。 参考技术A 多功能密码破解软件 4.5最新版 http://ud44.com/tuijian/duogongnenmimapojieruanjian_4_5zuixinban_857.html

楼主可以试试这个呀
软件说明里有excel97密码破解

目前本版本可以破解Access97/2000/xp密码，Word/Excel97/2000/xp、SQLSERVER（本地和远程）、windows98登陆密码、ZIP/RAR文件密码，星号密码察看，可以察看任何显示为*的密码内容（网页除外）。

如何去除Excel的VBA工程密码及工作表保护密码

某Vendor的PL采取了.xls+VBA的形式，功能多多，值得研习。无奈其工作表设置的编辑保护，VBA工程也存在密码。搜索了一下和谐办法如下：
引用自
https://www.cnblogs.com/nakata/p/9517605.html
http://jingyan.baidu.com/article/2009576170cc05cb0721b437.html

去除VBA工程密码的Sub在Excel2016, Win10 x64运行环境下，如在选择文件窗口不选择文件并返回，会出现报错。

去除VBA工程的保护

Private Sub VBAPassword() ‘你要解保护的Excel文件路径
Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")
If Dir(Filename) = "" Then
MsgBox "没找到相关文件,清重新设置。"
Exit Sub
Else
FileCopy Filename, Filename & ".bak" ‘备份文件。
End If
Dim GetData As String * 5
Open Filename For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get #1, i, GetData
If GetData = "CMG=""" Then CMGs = i
If GetData = "[Host" Then DPBo = i - 2: Exit For
Next
If CMGs = 0 Then
MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
Exit Sub
End If

Dim St As String * 2
Dim s20 As String * 1
‘取得一个0D0A十六进制字串
Get #1, CMGs - 2, St
‘取得一个20十六制字串
Get #1, DPBo + 16, s20
‘替换加密部份机码
For i = CMGs To DPBo Step 2
Put #1, i, St
Next
‘加入不配对符号
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End If
MsgBox "文件解密成功......", 32, "提示"
Close #1
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 & "                        FGHRSH 整理"
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 = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
"如果该文件工作表有不同密码,将搜索下一组密码并修改清除"
Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _
"如果该文件工作表有不同密码,将搜索下一组密码并解除"
Const MSGONLYONE As String = "确保为唯一的?"
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
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 & ZHENGLI, vbInformation, HEADER
End Sub