一，錄製乙個空白巨集
二，編輯巨集，替換以下**
public sub 工作表保護密碼破解()const dblspace as string = vbnewline &vbnewline
const authors as string = dblspace & vbnewline &_""
const header as string = "
工作表保護密碼破解
"const version as string = dblspace & "
版本 version 1.1.1
"const repback as string = dblspace & ""
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
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)"$$
", 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
0end 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
0shtag =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)"$$
", 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
0end if
end with
next w1
end if
msgbox allclear & authors & version &repback , vbinformation, header
end sub
三，執行即可
EXCEL 2013中「定義名稱」的命名規則
名稱可以包含字母 漢字 數字 以及 三種符號。名稱具有唯一性。名稱必須以字母或漢字或下劃線 作為開頭，不能以數字 字母r 字母c作為開頭，並且不能像單元格引用，例如，32和a4都不能作為區域名稱，由於excel 2007可以超過16 000列，不能使用cat1之類的區域名稱，因為存在乙個cat1單元...
Excel2013如何實現隔行設定背景色
第一種方法 套用格式 但格式中往往不是自己想要的效果 第二種方法 1 選中需要處理的單元格 2 在 開始 選項卡中，單擊 條件格式 選擇 新建規則 3 在開啟的對話方塊中，規則型別選擇 使用公式確定要設定格式的單元格 然後在 為符合此公式的值設定格式 下面填入公式 mod row 2 說明 如果隔二...
Excel 2013資料探勘工具欄的介紹（二）
這裡不多說，直接上乾貨！excel 2013資料探勘功能選單中，分成七大區塊工具欄 詳細的選項，分別見圖 資料準備的方式有 瀏覽資料 清除資料 分割資料。資料建模 開始進行資料探勘步驟，可以建立挖掘模型，分析等。資料建模的方法有分類 估計 聚類 和高階。準確性和驗證 由圖形來檢視挖掘模型。圖形有準確...