Excel工作表保护密码破解

去除Excel工作表保护密码

  1. 打开需要破解密码的Excel;
  2. Alt+F11,进入VBA编辑界面;
  3. 插入 -- 模块(Module);
  4. 在右边Module的空白编辑区域,复制粘贴下面所有内容;
  5. F5,运行该VBA命令;
Option Explicit

Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob McCormick
' probably originator of base code algorithm modified for coverage
' of workbook structure / windows passwords and for multiple passwords
'
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
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
MsgBox MSGNOPWORDS2, vbInformation, HEADER
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, vbInformation, HEADER
End Sub

 

Excel VBA中使用VLOOKUP函数

Function VBVlookup(code As Integer) As String
    On Error Resume Next
    
    Dim result As String
    Dim sheet As Worksheet
    Set sheet = ActiveWorkbook.Sheets("维修人员表")
    
    result = Application.WorksheetFunction.VLookup(code, sheet.Range("A:B"), 2, False)
    VBVlookup = result
End Function

另外附上VLOOKUP,查找不到不显示N/A的函数

=IF(ISERROR(VLOOKUP(A5,项目代码表!A:E,2,FALSE)),"",(VLOOKUP(A5,项目代码表!A:E,2,FALSE)))

Excel VBA 删除自定义样式宏

Sub Del_YS()
'删除自定义样式
For Each s In ActiveWorkbook.Styles
'MsgBox s.Name
On Error Resume Next
If Len(s.Name) > 0 And s.Name <> "Normal" Then
s.Delete
End If
If Err.Number > 0 Then
e = "Error occour on deleting Style named " & s.Name
e = e & vbCrLf & "Err:" & Err.Number & "->" & Err.Description
MsgBox e
Err.Clear
End If
Next
End Sub

 

Excel中如何找出两列数据中不重复的记录

需求:现在有两列数据,要在 A 列中找出 B 列中没有的记录,在 B 列中找出 A 列中没有的记录。现在和大家分享一下这个方法。
我们先用一个简单的例子看一下。现在有两列数据,可以是分别在不同的数据单(sheet)中。我们先来做个简单的眼力测验,看下面图中左侧,两列数据中不重复的部分把它找出来。

收起这个图片展开这个图片

01

这里数据比较少,我们很容易发现:(左) 列的的“周”、“郑”、“王”是 (右) 列没有的。(右) 列的“李”、“吴”是 (左) 列没有的。
现在我们看一下在 Excel 中如何用公式来实现这里功能。稍微有点难度,但是我们每步都会讲解得尽可能清晰,请不要担心。

  1. 我们先需要把两列数据定义到“数据块”中,并且分别为它们起个名字。分别叫“左边”和“右边”。相当于上面图中的 (左) 列和 (右) 列。
  2. 我们选中 (左) 列中所有的数据(这里位于第一张数据单的 A 列),然后选公式选项卡 -> 定义名称 -> 名称中填上“左边”-> 按确定退出。

    收起这个图片展开这个图片

    02

  3. 用同样的方法,选中 (右) 列数据(这里位于另一张数据单的 A 列),把它定义成“右边”。
  4. 然后在你数据列右边的那列头一个单元格,点中后在公式栏中输入

    =IF(ISNA(VLOOKUP(

    收起这个图片展开这个图片

    03

    注意公式要以等号开始。括号要用英文括号。

  5. 然后点左侧中对应的单元格,这里我们点 A1 单元格。

    收起这个图片展开这个图片

    04

  6. 然后在 A1 后面打个逗号(要用英文逗号),然后打右边

    收起这个图片展开这个图片

    05

  7. 然后再打个逗号,再打 1,再打个逗号,然后选 FALSE。

    收起这个图片展开这个图片

    06

  8. 选完 FALSE 后打上

    )),"新","")

    括号引号注意全要英文的。

  9. 完整公式是这样的,打完公式后按回车。

    收起这个图片展开这个图片

    07

  10. 我们看一下完整的公式。

    =IF(ISNA(VLOOKUP(A1,右边,1,FALSE)),"新","")

    如果你的数据在 A 这一列,如果按照前面一模一样的方法定义了“左边”和“右边”两个数据块。那么你可以干脆把这个公式原封不动贴进去。
    下面是是对几个重要参数的解释。

    收起这个图片展开这个图片

    08

  11. 接下去,我们要把公式拖到整列。把鼠标放到选中那个单元格右下角的那个小十字上,按住十字上往下拖。一直拖到这一列的末尾。

    收起这个图片展开这个图片

    09

  12. 我们看到“周”、“郑”、“王”右边出现了“新”,表示他们在另一块数据中是没有的。
  13. 我们在 (A) 列中找出了 (B) 列中没有的记录,用同样的方法在 (B) 列中找出了 (A) 列中没有的记录。用的公式是

    =IF(ISNA(VLOOKUP(A1,左边,1,FALSE)),"新","")

    收起这个图片展开这个图片

    10

    “周”、“郑”、“王”右边出现了“新”。“李”、“吴”右边出现了“新”。这些记录都是在另一列中没有的记录。

  14. 现在我们用这个方法找出了两列数据种中不同的项。

Excel身份证相关信息提取公式

1、根据身份证号码自动提取出生年月

=MID(B2,7,4)&"年"&MID(B2,11,2)&"月"&MID(B2,13,2)&"日"

2、根据身份证号码自动提取性别

=IF(MOD(RIGHT(LEFT(B2,17)),2),"男","女")

3、根据身份证号码自动提取年龄

=DATEDIF(TEXT(MID(B2,7,6+2*(LEN(B2)=18)),"#-00-00"),NOW(),"y")

Excel计算两个时间相差的分钟数

需求:

以9点32分为基准,在这时间之后打开的都算作迟到,并计算出时间差(分钟)

公式:

=IF(A2<=TIME(9,32,0),"未迟到",(A2-TIME(9,32,0))*1440)

演示 & 下载:

Excel奇偶页打印宏

右击工作表标签—查看代码—插入—模块—粘贴代码—关闭VBE编辑器,回到工作表,工具—宏—宏,选择Print_双面,单击执行。

Sub Print_双面()

Dim pageTotal As Integer
Dim jPage As Integer
Dim OK

pageTotal = Application.ExecuteExcel4Macro("get.document(50)")

For jPage = pageTotal - IIf(pageTotal Mod 2 = 0, 1, 0) To 1 Step -2
ActiveSheet.PrintOut from:=jPage, To:=jPage
Next

OK = MsgBox("请把纸张装入打印机,打印偶数页", vbOKCancel, "双面打印")

If OK = vbOK Then
For jPage = 2 To pageTotal Step 2
ActiveSheet.PrintOut from:=jPage, To:=jPage
Next
End If

End Sub

Excel将价钱小写转换大写

1、打开一个Excel工作表

2、按ALT+F11

3、新建一个模块

4、粘贴以下代码:

Public Function Daxie(M)
    Y = Int(Round(100 * Abs(M)) / 100)
    J = Round(100 * Abs(M) + 0.00001) - Y * 100
    F = (J / 10 - Int(J / 10)) * 10
    A = IIf(Y < 1, "", Application.Text(Y, "[DBNum2]") & "元")
    B = IIf(J > 9.5, Application.Text(Int(J / 10), "[DBNum2]") & "角", IIf(Y < 1, "", IIf(F > 1, "零", "")))
    C = IIf(F < 1, "整", Application.Text(Round(F, 0), "[DBNum2]") & "分")
    Daxie = IIf(Abs(M) < 0.005, "", IIf(M < 0, "负" & A & B & C, A & B & C))
End Function
5、在单元格中输入 =daxie(A1) 即可调用

SQL2005/SQL2008中使用SQL语句导入Excel的方法

注意此方法只能在SQL05以上版本才能使用,2000的请无视

格式如下:

insert into tableA
SELECT * FROM OPENROWSET('MICROSOFT.JET.OLEDB.4.0','Excel 8.0;IMEX=1;HDR=YES;DATABASE=D:\算神.xls',[sheet1$])

如果遇到下面的错误:

SQL Server blocked access to STATEMENT 'OpenRowset/OpenDatasource' of component 'Ad Hoc Distributed Queries' because this component is turned off as part of the security configuration for this server. A system administrator can enable the use of 'Ad Hoc Distributed Queries' by using sp_configure. For more information about enabling 'Ad Hoc Distributed Queries', see "Surface Area Configuration" in SQL Server Books Online.

 

请执行以下脚本:

exec sp_configure 'show advanced options',1 
reconfigure 
exec sp_configure 'Ad Hoc Distributed Queries',1 
reconfigure

PS:可以用VB/C#等编程语言拼凑此方法的SQL语句,然后使用SqlCommand执行,即可实现Excel的导入。不必像原来那样,先把Excel的值取出来,再循环插入SQL