網上下載來的Excel經常會有工作表保護，也就是無法修改，妄圖做任何修改的時候你就會看見這句話：

您試圖更改的單元格或圖表位於受保護的工作表中。若要進行更改，請取消工作表保護。您可能需要輸入密碼。

那麼這篇文章可以簡單的幫你解決這個問題...因為Excel中內建了Visual Basic，所以我們寫個巨集暴力破解密碼就可以了。。。

1. 當然是先開啟有保護密碼的Excel檔案

2. 新建一個巨集（不同版本的office巨集所在的位置不一樣，一般都在"選單—檢視" 中）

然後我們點選"錄製巨集"，名字隨便寫,然後再次點選，會發現錄製巨集的位置已經變成了“停止錄製”，點選“停止錄製”

3.在停止錄製後我們點選“檢視巨集”，找到我們剛才新建的巨集，比如我新建的名為“asd”，選中後點擊"編輯"

4. 然後在彈出的框中我們可以看到我們新建的空巨集"asd"

5. 把這個框內的所有內容全部刪除，將下面的所有程式碼複製進去

6. 關閉Visual Basic，回到我們的Excel，當然這裡不需要儲存，直接右上角叉掉即可

7. 然後我們回到最初的位置，點選“檢視巨集”，就會發現剛才我們新建的空巨集已經不見了，取而代之的是一個名為"Password_cracking"的巨集

8. 選中這個巨集，點選執行，就可以破解當前這份Excel中的工作保護密碼了

當然在執行完這個巨集之後，當前開啟的Excel中的密碼已經被清除，你可以選擇直接儲存這份Excel，這樣的話你的Excel就不再有密碼了，也可以選擇記下破解出來的密碼，然後關閉這個Excel重新開啟一次，輸入密碼解除保護

Public Sub Password_cracking()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"                      Author - jnxxhzz "
Const HEADER As String = "Password_cracking"
Const VERSION As String = DBLSPACE & "                      Version 1.0"
Const REPBACK As String = DBLSPACE & ""
Const ZHENGLI As String = DBLSPACE & ""
Const ALLCLEAR As String = DBLSPACE & "All password is clear" & DBLSPACE & "Please remember to save" 
Const MSGNOPWORDS1 As String = "No password!"
Const MSGNOPWORDS2 As String = "No password!"
Const MSGTAKETIME As String = "This will take some time , please wait for a while" & DBLSPACE & "Press next to start"
Const MSGPWORDFOUND1 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _
"If the file worksheet has a different password, it will search for the next set of passwords and release"
Const MSGPWORDFOUND2 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _
"If the file worksheet has a different password, it will search for the next set of passwords and release"
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
 

---- 此專案開源僅僅是為了交流學習，大肆流傳可能會對其他公司的商業產品造成損失，所以請自覺遵守法律以及道德規範，切勿將其挪作他用，更不可用其獲取商業利益！