做數(shù)據(jù)分析的人都知道，原始數(shù)據(jù)的正確性是非常重要的，常常會因為一個數(shù)據(jù)的錯誤，導(dǎo)致結(jié)果發(fā)生很大的偏差。

因此在工作表中將原始數(shù)據(jù)輸入完成并校對后，為了防止誤操作或是被他人隨意復(fù)制，都會選擇將這些數(shù)據(jù)進行保護。但隨著現(xiàn)代生活節(jié)奏的加快，再加上使用密碼的地方太多，因此忘記密碼的事情也是常有發(fā)生。當(dāng)辛辛苦苦做的一份工作表因為忘記密碼再也不能進行修改時，是不是感覺很郁悶?zāi)兀?/p>

這時該怎么辦呢？重做一份嗎？其實不用這么麻煩，下面我就為大家分享兩種常用的清除工作表保護密碼的方法。

利用VBA清除

1、點擊菜單欄中的“開發(fā)工具”，選擇錄制宏，錄制一個名為“清除工作表保護密碼”的宏文件（可以根據(jù)自己的習(xí)慣命名該宏文件）。

2、再次點擊菜單欄中的“開發(fā)工具”，選擇“宏”，打開宏對話框，“宏名”選擇剛剛新建的宏文件，然后點擊“編輯”，打開宏（VBA）編輯窗口。

3、在宏（VBA）編輯窗口的左側(cè)依次選擇“VBAProject PERSONAL,XLSB”→“模塊”→“模塊2”后，將右側(cè)的代碼窗口中的原有內(nèi)容刪除后，把以下代碼復(fù)制后粘貼在代碼窗口中保存。

4、再次點擊菜單欄中的“開發(fā)工具”，選擇“宏”，打開宏對話框，“宏名”選擇剛剛新建的宏文件，然后點擊“執(zhí)行”或“單步執(zhí)行”，等程序運行完成后工作表保護密碼就清除了。（提示：程序運行時有點卡，如果電腦配置低就選擇單步執(zhí)行，效果是一樣的）

VBA代碼如下：

Public Sub 工作表保護密碼破解()

Const HUANHANG As String = vbNewLine & vbNewLine

Const MINGCHEN As String = "清除工作表保護密碼"

Const JINGGAO As String = "該工作簿中的工作表密碼保護已全部清除!!" & HUANHANG & "請記得另保存" _

& HUANHANG & "注意：不要用在不當(dāng)?shù)胤剑�要尊重他人的勞動成果�?

Const TISHI1 As String = "該文件工作表中沒有加密"

Const TISHI2 As String = "該文件工作表中沒有加密2"

Const KSPJ As String = "解密需花費一定時間,請耐心等候!" & HUANHANG & "按確定開始清除!"

Const FXMM1 As String = "密碼重新組合為:" & HUANHANG & "$$" & HUANHANG & _

"如果該文件工作表有不同密碼,將搜索下一組密碼并修改清除"

Const FXMM2 As String = "密碼重新組合為:" & HUANHANG & "$$" & HUANHANG & _

"如果該文件工作表有不同密碼,將搜索下一組密碼并解除"

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 TISHI1, vbInformation, MINGCHEN

Exit Sub

End If

MsgBox KSPJ, vbInformation, MINGCHEN

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(FXMM1, _

"$$", PWord1), vbInformation, MINGCHEN

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, MINGCHEN

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(FXMM2, _

"$$", PWord1), vbInformation, MINGCHEN

'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 JINGGAO, vbInformation, MINGCHEN

End Sub

?