excel撤销工作表保护密码忘记了怎么办

excel撤销工作表保护密码忘记了怎么办

做数据分析的人都知道，原始数据的正确性是非常重要的，常常会因为一个数据的错误，导致结果发生很大的偏差。

因此在工作表中将原始数据输入完成并校对后，为了防止误操作或是被他人随意复制，都会选择将这些数据进行保护。但随着现代生活节奏的加快，再加上使用密码的地方太多，因此忘记密码的事情也是常有发生。当辛辛苦苦做的一份工作表因为忘记密码再也不能进行修改时，是不是感觉很郁闷呢？

这时该怎么办呢？重做一份吗？其实不用这么麻烦，下面我就为大家分享两种常用的清除工作表保护密码的方法。

利用VBA清除

1、点击菜单栏中的“开发工具”，选择录制宏，录制一个名为“清除工作表保护密码”的宏文件（可以根据自己的习惯命名该宏文件）。

2、再次点击菜单栏中的“开发工具”，选择“宏”，打开宏对话框，“宏名”选择刚刚新建的宏文件，然后点击“编辑”，打开宏（VBA）编辑窗口。

3、在宏（VBA）编辑窗口的左侧依次选择“VBAProject PERSONAL,XLSB”→“模块”→“模块2”后，将右侧的代码窗口中的原有内容删除后，把以下代码复制后粘贴在代码窗口中保存。

4、再次点击菜单栏中的“开发工具”，选择“宏”，打开宏对话框，“宏名”选择刚刚新建的宏文件，然后点击“执行”或“单步执行”，等程序运行完成后工作表保护密码就清除了。（提示：程序运行时有点卡，如果电脑配置低就选择单步执行，效果是一样的）

VBA代码如下：

Public Sub 工作表保护密码破解()

Const HUANHANG As String = vbNewLine & vbNewLine

Const MINGCHEN As String = "清除工作表保护密码"

Const JINGGAO As String = "该工作簿中的工作表密码保护已全部清除!!" & HUANHANG & "请记得另保存" _

& HUANHANG & "注意：不要用在不当地方，要尊重他人的劳动成果！"

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, vb***mation, MINGCHEN

Exit Sub

End If

MsgBox KSPJ, vb***mation, 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), vb***mation, 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, vb***mation, 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), vb***mation, 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, vb***mation, MINGCHEN

End Sub

excel撤销工作表保护密码忘记了怎么办的***：

本地下载