最全的OLE操作Excel的完整代码

EXCEL宏代码大全本文件部分文章来源于网络000. A列半角内容变红Sub A列半角内容变红() ? Dim rg As Range, i As Long ? Application.ScreenUpdating = False ? For Each rg In Cells.SpecialCells(xlCellTypeConstants, 3) For i = 1 To Len(rg) If Asc(Mid(rg, i, 1))001. A列等于A列减B列Sub A列等于A列减B列() For i = 1 To 23 Cells(i, 1) = Cells(i, 1) - Cells(i, 2) Next End Sub002. B列录入数据时在A列返回记录时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(, -1) = Now End If End Sub003. Excel宏常用代码本大类暂没有内容，以下是关于本类的所有记录集。

004. Sub 以当前日期为名称另存文件()ActiveWorkbook.SaveAs Filename:=Date & ".xls" End Sub005. Sub 启用保存()mandBars("File").Controls(4).Enabled = True mandBars("File").Controls(5).Enabled = True End Sub006. Sub 执行前需要验证密码的宏()If InputBox("请输入您的使用权限:", "系统提示") = 123 Then 重排窗口 ''要执行的宏代码或宏名称 Else MsgBox "对不起,您没有使用该宏的权限,按确定键后退出!" End If End Sub007. Sub 选择第5行开始所有数据行B()Rows("5:" & Cells.Find("*", , , , 1, 2).Row).Select End Sub008. VBA返回公式结果Sub VBA返回公式结果() x = Application.WorksheetFunction.Sum(Range("a2:a100"))Range("B1") = x End Sub009. 不连续区域录入对勾Sub 批量录入对勾() Selection.FormulaR1C1 = "√" End Sub010. 不连续区域录入当前单元地址Sub 区域录入当前单元地址() For Each mycell In Selection mycell.FormulaR1C1 = mycell.Address Next End Sub011. 不连续区域录入当前数字日期Sub 区域录入当前数字日期() Selection.FormulaR1C1 = Format(Now(), "yyyymmdd") End Sub012. 不连续区域录入当前文件名Sub 批量录入当前文件名() Selection.FormulaR1C1 = End Sub013. 不连续区域录入当前日期Sub 区域录入当前日期() Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d") End Sub014. 不连续区域录入当前日期和时间Sub 区域录入当前日期和时间() Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss") End Sub015. 不连续区域插入当前文件名和表名及地址Sub 批量插入当前文件名和表名及地址() For Each mycell In Selection mycell.FormulaR1C1 = "[" + + "]" + + "!" + mycell.Address Next End Sub016. 不连续区域插入文本Sub 批量插入文本() Dim s As Range For Each s In Selection s = "文本内容" & s Next End Sub017. 不连续区域添加文本Sub 批量添加文本() Dim s As Range For Each s In Selection s = s & "文本内容" Next End Sub018. 为当前选定的多单元插入指定名称Sub 为当前选定的多单元插入指定名称() = "临时" s.Add Name:="临时", RefersT o:=Selection ''或者换用这行代码也可以 End Sub019. 为指定工作表加指定密码保护表Sub 为指定工作表加指定密码保护表() Sheet10.Protect Password:="123" End Sub020. 为指定工作表设置滚动范围（工作簿代码）Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Sheet1.ScrollArea = "A1:M30" EndSub021. 从指定位置向下同时录入多单元指定内容Sub 从指定位置向下同时录入多单元指定内容() Dim arr arr = Array("1", "2", "13", "25", "46", "12", "0", "20") [B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr) End Sub022. 以A1单元内容批量插入批注Sub 以A1单元内容批量插入批注() Dim r As Range If Selection.Cells.Count > 0 Then For Each r In Selection r.AddComment ment.Visible = False ment.Text Text:=[a1].T ext Next End If End Sub023. 以A1单元文本作表名插入工作表Sub 以A1单元文本作表名插入工作表() Dim nm As String nm = [a1] Sheets.Add = nm End Sub024. 以当前日期为新文件名另存文件Sub 以当前日期为新文件名另存文件() ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Now(), "yyyymmdd") & ".xls" End Sub025. 以当前日期和时间为新文件名另存文件Sub 以当前日期和时间为新文件名另存文件() ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Now(), "yyyy" & "年" & "mm" & "月" & "dd" & "日" & "h" & "时" & "mm" & "分" & "ss" & "秒") & ".xls" End Sub026. 以指定区域为表目录补充新表Sub 以指定区域为表目录补充新表() Dim dic As Object, sh AsWorksheet Dim arr, item arr = Range("B1:BB1") Set dic = CreateObject("scripting.dictionary") For Each sh In ThisWorkbook.Worksheets dic.Add ,027. 以指定单元内容为新文件名另存文件Sub 以指定单元内容为新文件名另存文件() ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheet1.[A1] End Sub028. 以本工作表名称另存文件到当前目录Sub 以本工作表名称另存文件到当前目录() ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & & ".xls" End Sub029. 以活动工作表名称另存文件到Excel当前默认目录Sub 以活动工作表名称另存文件到Excel当前默认目录() ActiveWorkbook.SaveAs Filename:= & ".xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=030. 使单元内容保持不变的工作表代码Private Sub Worksheet_Change(ByVal Target As Range) [B2] = "不可更改的数据" End Sub031. 保存并退出ExcelSub 保存并退出Excel() Application.SendKeys ("{ENTER}{ENTER}%fx") ActiveWorkbook.Save End Sub032. 保护工作表时取消选定锁定单元Sub 取消选定锁定单元() ActiveSheet.EnableSelection =xlUnlockedCells ''用于2000版 End Sub033. 光标定位到名称指定位置Sub 定位() Application.Goto Range(Evaluate("名称")) End Sub034. 光标定位到指定工作表A列最后数据行下一单元Sub 光标定位到指定工作表A列最后数据行下一单元() a = Sheets("数据库").[a65536].End(xlUp).Row Sheets("数据库").Select Range("A" & a + 1).Select End Sub035. 光标所在行上移一行Sub 光标所在行上移一行() Dim i% i = Split(ActiveCell.Address, "$")(2) If i > 1 Then Rows(i).Cut Rows(i - 1).Insert Shift:=xlDown End If End Sub036. 光标移动Sub 光标移动() ActiveCell.Offset(1, 2).Select ''向下移动1行，向右移动2列 End Sub037. 全选固定范围内小于0的单元Sub 全选固定范围内小于0的单元() Dim rng As Range Dim yvhf For Each rng In Range("d6: i18") If rng < 0 Then yvhf = yvhf & rng.Address & "," End If Next Range(Left(yvhf, Len(yvhf) - 1)).Select End Sub038. 全选选定范围内小于0的单元Sub 全选选定范围内小于0的单元() Dim rng As Range Dim yvhf For Each rng In Selection If rng < 0 Then yvhf = yvhf & rng.Address & "," End If Next Range(Left(yvhf, Len(yvhf) - 1)).Select End Sub039. 全部显示指定表的自动筛选Sub 全部显示指定表的自动筛选() If Sheet1.FilterMode = True Then Sheet1.ShowAllData End If End Sub040. 全部清除当前选择区域Sub 全部清除当前选择区域() Selection.Clear '' Range("A1:B10").Clear ''全部清除指定区域 End Sub041. 关闭文件时执行指定宏(工作簿代码)Private Sub Workbook_BeforeClose(Cancel As Boolean) 重排窗口 ''要执行的宏名称 End Sub042. 关闭文件时自动隐藏指定工作表(ThisWorkbook)Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Unprotect Sheets("Sheet2").Visible = False Sheets("Sheet3").Visible = False ActiveWorkbook.Protect Structure:=True, Windows:=Fal043. 分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表Sub 分离A列数据的文本和超链接并会同其他数据整理到指定表() ier = Worksheets("数据库").Range("b60000").End(xlUp).Row For ee = 5 To Range("a60000").End(xlUp).Row For Each hh In Worksheets("临时").Hyperlinks If hh.T extToDisplay =044. 分离临时表A列数据的文本和超链接并整理到数据库表Sub 分离A列中的超链接到指定表的B和C列() i = Worksheets("数据库").Range("b60000").End(xlUp).Row For Each h In Worksheets("临时").Hyperlinks Worksheets("数据库").Cells(i + 1, 2)= h.TextT oDisplay Worksheets("数据库").Cells(045. 删除A列为指定内容的行Sub 删除A列为指定内容的行() Dim a, b As Integer a = Sheet1.[a65536].End(xlUp).Row For b = a To 2 Step -1 If Cells(b, 1).Value = "删除" Then Rows(b).Delete End If Next End Sub046. 删除A列空行Sub 删除A列空行() Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub047. 删除A列非数字单元行Sub 删除A列非数字单元行() i = [a65536].End(xlUp).Row Range("A1:A" & i).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete End Sub048. 删除B列数据的超链接Sub 删除超链接() For Each Rng In Range("B3:B" & [B65536].End(xlUp).Row)Sheet1.Range(Rng.Address).Hyperlinks.Delete Next End Sub049. 删除全部名称Sub 删除全部名称() On Error Resume Next Dim l As Integer l = s.Count For i = l T o 1 Step -1 s(i).Delete Next End Sub050. 删除全部未选定工作表Sub 删除全部未选定工作表() Dim sht As Worksheet, n As Integer, iFlag As Boolean Dim ShtName() As String n =ActiveWindow.SelectedSheets.Count ReDim ShtName(1 To n) n = 1 For Each sht In ActiveWindow.Selec051. 删除包含固定文本单元的行或列Sub 删除包含固定文本单元的行或列() Do Cells.Find(what:="哈哈").Activate Selection.EntireRow.Delete ''删除行 '' Selection.EntireColumn.Delete ''删除列 Loop Until Cells.Find(what:="哈哈") Is Nothing End Sub052. 删除指定文件Sub 删除指定文件() Kill "E:\信件\1.xls" End Sub053. 删除指定行Sub 删除指定行() Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub054. 判断指定文件是否已经打开Sub 判断指定文件是否已经打开() Dim x As Integer For x = 1 To Workbooks.Count If Workbooks(x).Name = "函数.xls" Then ''文件名称 MsgBox "文件已打开" Exit Sub End If Next MsgBox "文件未打开" End Sub055. 加数据有效限制Sub 加数据有效限制() With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="******************".IgnoreBlank = False .InCellDropd056. 单元区域引用（工作表代码）Private Sub Worksheet_Activate()Sheet1.Range("A1:B3").Value = Sheet2.Range("A1:B3").Value End Sub057. 单元反选Sub 单元反选() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim raddress As String, taddress As String raddress = Selection.Address taddress = edRange.Address058. 单元格录入1位字符就跳转(工作表代码)Private Sub TextBox1_Change() If Len(Me.TextBox1.Text) <> 1 Then Exit Sub Me.TextBox1.Activate ActiveCell = Me.TextBox1.Text Me.TextBox1.Text = "" ActiveCell.Activate Application.SendKeys "~"059. 单元格录入数据时运行宏的代码Private Sub Worksheet_Change(ByVal Target As Range) 重排窗口 End Sub060. 去除指定范围内的对象Sub 去除指定范围内的对象() ??Dim p As Shape Set My = Worksheets("工作表名") For Each p In My.Shapes If Not Application.Intersect(p.T opLeftCell, Range("范围")) Is Nothing Then p.Delete Next061. 双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" Then Exit Sub Select Case T arget.Address Case "$A$4" Call 宏1 Cancel = True Case "$B$4"062. 双击单元隐藏该行（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Rows(Target.Row).Hidden = True End Sub063. 双击指定区域单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" Then Exit Sub If Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then064. 双击指定单元，循环录入文本（工作表代码）Dim nums As Byte Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Then nums = nums Mod 3 + 1 Target = Mid("上中下", nums, 1) T arget.Offse065. 反方向文本(自定义函数)Function zhyz(zhyz1 As Range) zhyz = StrReverse(zhyz1) End Function 将代码复制到模块后单元公式：=zhyz(单元格)066. 取消指定行或列的隐藏Sub 取消隐藏行() Rows("3:5").Select Selection.EntireRow.Hidden = False End Sub Sub 取消隐藏列() Columns("C:F").Select Selection.EntireColumn.Hidden = False End Sub067. 取消数据有效限制Sub 取消数据有效限制() WithSelection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = False .InCellDropdown = False .InputTitle =068. 取消自动筛选()Sub 取消自动筛选() ActiveSheet.AutoFilterMode = False End Sub069. 取消选定区域的公式只保留值(假空转真空)Sub 取消选定区域的公式只保留值() ?''?? Sheets("数据归并集中").Select ''指定工作表 ?''?? Columns("Q:R").Select ''指定范围 Selection.Value = Selection.Value End Sub070. 另存所有工作表为工作簿Sub 另存所有工作表为工作簿() Dim sht As Worksheet Application.ScreenUpdating = False ipath = ThisWorkbook.Path & "\" For Each sht In Sheets sht.Copy ActiveWorkbook.SaveAs ipath & & ".xls" ''(工作表名071. 另存指定文件名Sub 另存指定文件名() ActiveWorkbook.SaveAs ThisWorkbook.Path & "\别名.xls" End Sub072. 另存本表为TXT文件Sub 另存本表为TXT文件() Dim s As String Dim FullName As String, rng As Range Application.ScreenUpdating = False FullName = ( & ".txt") ''以当前表名为TXT文件名 '' FullName = Replace(ThisWorkboo073. 右侧单元自动加5(工作表代码)Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target.Offset(0, 1) = T arget + 5 Application.EnableEvents = True End Sub074. 合并A1至C1的内容写到D15单元的批注中‘/dispbbs.asp?boardid=2&id=251887 northwolves版主 Sub 将A1至C1的内容写到D15单元的批注中() [iv1:iv12] = "=rc1 & "" ""& rc2 &"" ""& rc3" [d15].AddComment Join(Application.Transpose([iv1:i075. 合并各工作表内容Sub 合并各工作表内容() sp = InputBox("各表内容之间，间隔几行？不输则默认为0") If sp = "" Then sp = 0 End If st = InputBox("各表从第几行开始合并？不输则默认为2") If st = "" Then st = 2 End If Sheets(1).Select Sheets.Add If st076. 合并指定目录中所有文件中相同格式工作表的数据Sub 合并数据() ''合并指定目录中所有文件中相同格式工作表的数据 ''见/dispbbs.asp?boardid=1&replyid=900613&id=249319&page=1 &skin=0&Star=2帖11楼eq800的代码 Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i077. 回车光标向下Sub 录入光标向下() Application.MoveAfterReturnDirection = xlDown End Sub078. 回车光标向右Sub 录入光标向右() Application.MoveAfterReturnDirection =xlToRight End Sub079. 固定区域单元分类变色Sub 单元分类变色() Dim rng As Range For Each rng In Range("d6: i18") If rng < 0 Then rng.Interior.ColorIndex = 4 ''小于0的单元变绿底色 End If Next For Each rng In Range("d6: i18") If rng > 0 Then rng.080. 在A1返回当前选中单元格数量Sub 在A1返回当前选中单元格数量() [A1] = Selection.Count End Sub081. 在A列产生不重复随机数Sub 在A列产生不重复随机数() Randomize Timer Dim c(100) As Byte For i = 1 To 100 ''产生100个随机数 c(i) = i Next k = 100 Do While l < 100 r = Int(Rnd() * k) + 1 ''随机数的范围 aa = c(r) c(r) = c(k) c(k) = aa k =082. 在A和B列返回当前选区的名称和公式Sub 在A和B列返回当前选区的名称和公式() [a1].ListNames End Sub083. 在F1单元显示光标位置批注内容的代码Private Sub Worksheet_SelectionChange(ByVal Target As Range) a = Selection.Address b = Range(a).NoteText Cells(1, 6) = b End Sub084. 在M和N列的14行以下选择单元时显示调用日历控件（工作表代码）Private Sub Calendar1_Click() With Calendar1 ActiveCell= .Value .Visible = False End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 13 And Target085. 在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option Explicit Private Sub CommandButton1_Click() With CommandButton1 If .Caption = "宏1" Then Call 宏1 .Caption = "宏2" Exit Sub End If If .Caption = "宏2" Then Call 宏2 .Caption = "宏3" Exit S086. 在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click() With CommandButton1 If .Caption = "保护工作表" Then Call 保护工作表 .Caption = "取消工作表保护" Exit Sub End If If .Caption = "取消工作表保护" Then Call 取消工作表保护 .Caption = "保护工作表"087. 在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click() Static RunMacro As Integer Select Case RunMacro Case 0 宏1 RunMacro = 1 Case 1 宏2 RunMacro = 2 Case 2 宏3 RunMacro = 0 End Select End Sub088. 在当前工作组各表中分别执行指定宏''northwolves版主解答 /dispbbs.asp?boardid=2&id=251426&star=2#914934 Sub 在当前工作组各表中分别执行指定宏() Dim SH As Worksheet For Each SH In ActiveWindow.SelectedSheets SH.Activate 临时 N089. 在当前选区有条件替换数值为文本Sub 在当前选区有条件替换数值为文本() For Each r In Selection If r.Value > 18 And r.Value < 29.5 Then r.Value = "Y" Next End Sub090. 在所有工作表的A1单元返回顺序号Sub 在所有工作表的A1单元返回顺序号() For i = 1 T o Sheets.Count Sheets(i).Cells(1, 1) = "''" & Application.WorksheetFunction.Text(0 + i, "000") Next End Sub091. 在指定区域选择单元时数值加1（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Application.Intersect([a1:e10], Target) Is Nothing Then Target = Val(Target) + 1 End If End Sub092. 在指定单元记录打印和预览次数（工作簿代码）Private Sub Workbook_BeforePrint(Cancel As Boolean) Range("A1") = 1 + Range("A1") End Sub093. 在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Worksheets("表2").Range("A1") = Target.Address(0, 0) End Sub094. 在有密码的工作表执行代码Sub 在有密码的工作表执行代码() Sheets("1").Unprotect Password:=123 ''假定表名为“1”，密码为“123”打开工作表 Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ''隐藏C列空值行 Sheets("1").Protect Password:=123095. 在目录表建立本工作簿中各表链接目录Sub 在目录表建立本工作簿中各表链接目录() Dim s%, Rng As Range On Error Resume Next Sheets("目录").Activate If Err = 0 Then Sheets("目录").UsedRange.Delete Else Sheets.Add = "目录" End If For i =096. 在第一个表前插入多工作表Sub 在第一个表前插入多工作表() Sheets(1).Select For I = 1 To 50 = "新表" & I Next End Sub097. 填公式Sub 填公式() Range("C2:C12").Value = "=SUM(A2:B2)" End Sub098. 处理导入的显示为科学计数法样式的身份证号Sub 处理导入的显示为科学计数法样式的身份证号() Selection.Value = Selection.Formula End Sub099. 复制单元数值Sub 复制数值() s = Workbooks("book1").Sheets("Sheet1").Range("A1:A2") Workbooks("book2").Sheets("Sheet1").Range("A1:A2") = s End Sub100. 复制单元格所在列Sub 复制单元格所在列() Selection.EntireColumn.Copy End Sub101. 复制单元格所在行Sub 复制单元格所在行() Selection.EntireRow.Copy End Sub102. 复制当前工作簿的报表到临时工作簿Sub 复制当前工作簿的报表到临时工作簿() ''作者：yuanzhuping 版主 Dim x As Integer Dim sht As Worksheet On Error Resume Next For x = 1 To Workbooks.Count If Workbooks(x).Name = "临时.xls" Then For Each sht In Workbook103. 奇偶页分别打印Sub 奇偶页分别打印() Dim i%, Ps% Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") ''总页数 MsgBox "现在打印奇数页,按确定开始." For i = 1 To Ps Step 2 ActiveSheet.PrintOut from:=i, To:=i Next i MsgBox "现在打印偶数页,按确定开始." For104. 定义指定工作表标签颜色Sub 定义指定工作表标签颜色() Sheets("Sheet1").T ab.ColorIndex = 46 End Sub105. 定位数据及区域以上的空值Sub 定位数据及区域以上的空值() Dim aa As Range For Each a In edRange If a Like〈0 Then If aa Is Nothing Then Set aa = a.Cells Else Set aa = Union(aa, a.Cells) End If End If Next aa.Select106. 定位选定单元格式相同的全部单元格Sub 定位选定单元格式相同的全部单元格() Dim FirstCell As Range, FoundCell As Range Dim AllCells As Range With Application.FindFormat .Clear .NumberFormatLocal = Selection.NumberFormatLocal .HorizontalAlignment =107. 实现删去特定的行Sub test() For Each i In ThisWorkbook.Worksheets(1).range("E:E") If i.Value = "32766" Then Rows(i.Row).Delete End If Next i End Sub ''用的是第一张工作表，可以按需要改Worksheets(1)为指定的工作表。

常⽤Excel操作代码公式1.对⽐两列对应⾏的数据是否都相同=IF(A:A=B:B,"相同","不同")2.对⽐两列所有⾏，第⼆列在第⼀列中数据是否重复如果第⼆列在第⼀列有则显⽰为重复否则显⽰为不重复=IF(COUNTIF(A:A,B1)=0,"不重复","重复")3.如果A列的数据没有在B列出现过，就保留单元格为空。

如果A列的数据在B列出现过，就返回A列对应的数据。

C1输⼊公式：=IF(ISERROR(MATCH(A1,$B$1:$B$5,0)),"",A1)4.第⼀列的数据在第⼆列，如果有则返回第⼀列在第⼆列的位置⾏，否则返回#N/A 输⼊公式=MATCH(A1,B:B,)5. 如果只想在A列标⽰出哪些内容再B列⾥出现过可以⽤条件格式。

（1）⾸先，从A1开始选中A列数据，点击【开始】-【条件格式】-【新建规则】。

（2）选择【使⽤公式确定要设置格式的单元格】。

（3）输⼊公式=COUNTIF(B:B,A1)>0，然后点击【格式】按钮。

（4）选择⼀个填充颜⾊，并确定。

（5）就可以看到A列中在B列存在的内容就都被标上了颜⾊。

6.从⾝份证号码⾥提取出⽣年⽉⽇=IF(LEN(A2)=15,"19"&MID(A2,7,2)&"-"&MID(A2,9,2)&"-"&MID(A2,11,2), MID(A2,7,4)&"-"&MID(A2,11,2)&"-"&MID(A2,13,2)) 7.⾝份证号码提取出性别=IF(MOD(MID(A2,17,1),2)=1,"男","⼥")8.根据⾝份证号码求岁数=DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00-00"),TODAY(),"y")&"周岁零"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"ym")&"⽉"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"md")&"天"9根据⾝份证号码求岁数精确到⽉=DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00-00"),TODAY(),"y")&"周岁零"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"ym")&"⽉"10.根据阿拉伯数字变为⼤写数字=IF(ROUND(F2,2)<0,"⽆效数值",IF(ROUND(F2,2)=0,"零",IF(ROUND(F2,2)<1,"",TEXT(INT(ROUND(F2,2)),"[dbnum2]")&"元")&IF(INT(ROUND(F2,2)*10)-INT(ROUND(F2,2))*10=0,IF(INT(ROUND(F2,2))*(INT(ROUND(F2,2)*1 00)-INT(ROUND(F2,2)*10)*10)=0,"","零"),TEXT(INT(ROUND(F2,2)*10)-INT(ROUND(F2,2))*10,"[dbnum2]")&"⾓")&IF((INT(ROUND(F2,2)*100)-INT(ROUND(F2,2)*10)*10)=0,"整",TEXT((INT(ROUND(F2,2)*100)-INT(ROUND(F2,2)*10)*10),"[dbnum2]")&"分")))F2更改为⼩写数所在列。

最全的OLE操作Excel的完整代码#include<Utilcls.h>#include "Excel_2K_SRVR.h"//#include "ComObj.hpp"/*-------------------------------------------------//谨慎的思考310032649原创文章//目前真正最全的OLE操作Excel的完整代码//版本：2007.01.15.01//C++Builder专家组原创文章//转载请保留本版权信息，谢谢合作--------------------------------------------------/void __fastcall TForm1::Button1Click(TObject *Sender){AnsiString str1="asvasd";//要入库的数据Variant ex,newxls,sh;try{ex=CreateOleObject("Excel.Application");//启动Excelex.OlePropertySet("Visible",(Variant)true);//使Excel启动后可见//ex.OlePropertyGet("WorkBooks").OleProcedure("ADD");//新建一新工作薄(加上这一句，会有两个Excel窗口，同时关闭)//ex.OlePropertySet("Visible",(Variant)false);//使Excel启动后不可见//ex.OlePropertySet("Windowstate",1);//Excel启动后窗体状态：1(xlNormal)正常显示(Excel上次关闭时是什么状态，启动后就是什么状态)，2(xlMinimized)最小化(不是缩小到任务栏)，3(xlMaximized)最大化newxls=(ex.OlePropertyGet("Workbooks")).OleFunction("Add");//①//使用ExcelApp的Exec方法新建一有3个工作表的默认工作薄//newxls=(ex.OlePropertyGet("Workbooks")).OleFunction("Add",1);//创建有单个工作表的工作簿//newxls=ex.OlePropertyGet("workbooks").OleFunction("open", "c:\\123.xls");//打开已存在的文件，使用时可将上面关于新建①的那行屏蔽掉sh=newxls.OlePropertyGet("ActiveSheet");}catch(...){ShowMessage("启动Excel出错，可能沒有安裝Excel");return;}//Excel的警告提示：sh.OlePropertyGet("Application").OlePropertySet("DisplayAlerts",false);//关闭Excel的警告提示，如提示保存等//sh.OlePropertyGet("Application").OlePropertySet("DisplayAlerts",true);//打开Excel的警告提示，如提示保存等//选择工作表：//newxls.OlePropertyGet("Sheets", 2).OleProcedure("Select");//选择第二工作表//sh = newxls.OlePropertyGet("ActiveSheet");//选择第二工作表//重命名工作表：//sh.OlePropertySet("Name", "Sheet的新名字");//重命名当前工作表//取得工作表总数：int nSheetCount=newxls.OlePropertyGet("Sheets").OlePropertyGet("Count");//取得工作表总数Edit1->Text=nSheetCount;/*-------------------------------------------------//目前真正最全的OLE操作Excel的完整代码//版本：2007.01.15.01//C++Builder专家组原创文章//转载请保留本版权信息，谢谢合作--------------------------------------------------///新建工作表并重命名：try{Variant bef1,aft1;int count=ex.OlePropertyGet("sheets").OlePropertyGet("count");aft1=ex.OlePropertyGet("sheets",count);ex.OlePropertyGet("sheets").OleProcedure("Add",bef1.NoParam() , aft1);sh = ex.OlePropertyGet("ActiveSheet");sh.OlePropertySet("Name","增加的sheet的名字");//名字不能重复}catch(...){//ShowMessage ("There's something wrong with your excel file./nPlease check it!");}//指定状态栏显示的文本：//ex.OlePropertySet ("StatusBar","您好，请您稍等。

经典ExcelVBA代码Application（Excel程序）篇Application.EnableEvents= True/ False ’启用/禁用所有事件Application.DisplayAlerts=True/False ’显示/关闭警告框提示框Application.ScreenUpdating= True/False ’显示/关闭屏幕刷新Application.StatusBar = "软件报专用" ’在地址栏中显示文本，标题栏用Caption属性Application.Cursor = xlIBeam ‘设置光标形状为Ⅰ字形，xlWait为沙漏(等待)形，xlNormal为正常Application.WindowState = xlMinimized ‘窗口最小化，xlMaximized最大化，xlNormal为正常Application.ActivateMicrosoftApp xlMicrosoftWord ’开启Word应用程序Application.TemplatesPath ‘获取工作簿模板的位置Application.CalculateFull ’重新计算所有打开的工作簿中的数据Application.RecentFiles.Maximum = 2 ’将最近使用的文档列表数设为2Application.RecentFiles(3).Open ’打开最近打开的文档中的第3个文档Application.AutoCorrect.AddReplacement "sweek", "软件报" ’自动将输入的"sweek"更正为"软件报"Application.Dialogs(xlDialogPrint).Show ‘显示打印文档的对话框Application.OnTime Now + TimeValue("00:00:45"), "process" ’45分钟后执行指定过程Application.OnTime TimeValue("14:00:00"), " process " ’下午2点执行指定过程Application.OnTime EarliestTime:=TimeValue("14:00:00"), _ Procedure:="process", Schedule:=False ’取消指定时间的过程的执行Application.CutCopyMode = False 退出复制/剪切模式后，在程序运行时所进行的复制或剪切操作不会在原单元格区域留下流动的虚框线。

1、打开显示登录窗体代码打开隐藏表格，显示登录窗体private Sub Workbook_open()Application.Visible = falseUserForm1.Showend Sub2、固定账号、密码登录窗体设置（1）制作窗体（2）登录验证Private Sub CommandButton1_Click() If TextBox1 = "admin" ThenIf TextBox2 <> 123 ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功”"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub（3）退出按钮Private Sub CommandButton2_Click() Unload MeThisWorkbook.CloseEnd Sub(4)打开注册窗体Private Sub CommandButton3_Click() UserForm2.ShowEnd Sub（5）唯一关闭代码Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> 1 Then Cancel = TrueEnd Sub3、注册账号（1）制作注册账号窗体（2）注册代码Private Sub CommandButton1_Click()Dim zh As Range, zt As RangeIf TextBox1 = "" Then MsgBox "未填入账户": Exit SubIf TextBox2 <> TextBox3 Then MsgBox "密码不一致": Exit SubSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1)If zh Is Nothing ThenSet zt = Sheets("注册").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) zt = TextBox1.Textzt.Offset(0, 1) = TextBox2.Textzt.Offset(0, 2) = NowMsgBox "注册成功"Unload MeElseMsgBox "账号已经存在，请更换其他账号"End IfEnd Sub4、查找筛选代码Private Sub TextBox1_Change()If Len(TextBox1.Value) = 0 ThenSheet1.AutoFilterMode = FalseElseIf Sheet1.AutoFilterMode = True ThenSheet1.AutoFilterMode = FalseEnd IfSheet1.Range("B7:P" & Rows.Count).AutoFilter _field:=4, Criteria1:="*" & TextBox1.Value & "*"End IfEnd Sub5、多账号密码验证代码Private Sub CommandButton1_Click()If Len(TextBox1) = 0 Then MsgBox "未输入账号": Exit SubDim zh As RangeSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1) If Not zh Is Nothing ThenIf TextBox2.Text <> zh.Offset(0, 1) ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub6、默认打开第一个工作表Private Sub Workbook_Open()Sheet1.ActivateEnd Sub7、退出保存工作表Private Sub Workbook_BeforeClose(Cancel As Boolean) ThisWorkbook.SaveEnd Sub。

1.对比两列对应行的数据是否都相同=IF(A:A=B:B,"相同","不同")2.对比两列所有行，第二列在第一列中数据是否重复如果第二列在第一列有则显示为重复否则显示为不重复=IF(COUNTIF(A:A,B1)=0,"不重复","重复")3.如果A列的数据没有在B列出现过，就保留单元格为空。

如果A列的数据在B列出现过，就返回A列对应的数据。

C1输入公式：=IF(ISERROR(MATCH(A1,$B$1:$B$5,0)),"",A1)4.第一列的数据在第二列，如果有则返回第一列在第二列的位置行，否则返回#N/A 输入公式=MATCH(A1,B:B,)5. 如果只想在A列标示出哪些内容再B列里出现过可以用条件格式。

（1）首先，从A1开始选中A列数据，点击【开始】-【条件格式】-【新建规则】。

（2）选择【使用公式确定要设置格式的单元格】。

（3）输入公式=COUNTIF(B:B,A1)>0，然后点击【格式】按钮。

（4）选择一个填充颜色，并确定。

（5）就可以看到A列中在B列存在的内容就都被标上了颜色。

6.从身份证号码里提取出生年月日=IF(LEN(A2)=15,"19"&MID(A2,7,2)&"-"&MID(A2,9,2)&"-"&MID(A2,11,2), MID(A2,7,4)&"-"&MID(A2,11,2)&"-"&MID(A2,13,2))7.身份证号码提取出性别=IF(MOD(MID(A2,17,1),2)=1,"男","女")8.根据身份证号码求岁数=DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00-00"),TODAY(),"y")&"周岁零"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"ym")&"月"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"md")&"天"9根据身份证号码求岁数精确到月=DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00-00"),TODAY(),"y")&"周岁零"&DATEDIF(--TEXT((LEN(A1)=15)*19&MID(A1,7,6+(LEN(A1)=18)*2),"0-00 -00"),TODAY(),"ym")&"月"10.根据阿拉伯数字变为大写数字=IF(ROUND(F2,2)<0,"无效数值",IF(ROUND(F2,2)=0,"零",IF(ROUND(F2,2)<1,"",TEXT(INT(ROUND(F2,2)),"[dbnum2]")&"元")&IF(INT(ROUND(F2,2)*10)-INT(ROUND(F2,2))*10=0,IF(INT(ROUND(F2,2))*(INT(ROUND(F2,2)*1 00)-INT(ROUND(F2,2)*10)*10)=0,"","零"),TEXT(INT(ROUND(F2,2)*10)-INT(ROUND(F2,2))*10,"[dbnum2]")&"角")&IF((INT(ROUND(F2,2)*100)-INT(ROUND(F2,2)*10)*10)=0,"整",TEXT((INT(ROUND(F2,2)*100)-INT(ROUND(F2,2)*10)*10),"[dbnum2]")&"分")))F2更改为小写数所在列。

用OLE操作EXCEL文件一、首先在函数最上方加入以下头文件（很重要）#include "stdio.h"#include "Excel_2K_SRVR.h"在头文件中的private下定义：Variant Ex,Wb,Sheet,ERange,EBorders;二、要先创建和设置以下函数。

AnsiString ExcelFileName=GetCurrentDir()+"\\table.xls";Ex=Variant::CreateObject("Excel.Application");//创建应用对象Ex.OlePropertySet("Visible",false);//使Excel程序不可见Wb=Ex.OlePropertyGet("WorkBooks").OleFunction("Add"); Wb.OleProcedure("SaveAs",ExcelFileName.c_str());//根据路径保存Wb.OleProcedure("Close");//关闭工作簿Ex.OleFunction("Quit");//关闭Excel(以上函数可实现对EXCEL的创建然后保存关闭)三、要对所创建的EXCEL文件进行错误检测try{Ex=Variant::CreateObject("Excel.Application");}catch(…){Application->MessageBox("无法启动Excel","错误",MB_ICONSTOP|MB_OK);return;}四、当第三中的try中有创建EXCEL对象，就有对它的属性也就是显示或隐藏进行设置和打开，如下：Ex.OlePropertySet("Visible",false);Ex.OlePropertyGet("WorkBooks").OleProcedure("Open",ExcelFile Name.c_str());//打开指定的Excel表格文件。

1.删除重复行 (1)2. ActiveX控件的相关操作 (1)3. 单元格内容匹配 (2)4。

单元格填充公式 (3)5。

弹出打开对话框 (3)6. 操作文件夹下的所有工作簿 (3)7. 获取数据区域的最后一行和最后一列 (4)8. 获取列的字母顺序[A~IV］ (4)9. 自定义函数返回数组并填充至单元格区域 (4)10. 绘制曲线图 (5)11. 单元格区域拷贝 (5)12. 操纵数据库(查、增、删、改） (6)13。

待定XX (6)1.删除重复行关键字：[a65536］.End（xlUp).Row、Offset（)、相关双层循环Sub RemoveDuplicate(）'删除重复行For i = [a65536].End(xlUp)。

Row — 1 To 1 Step —1 '按倒叙删除For j = [a65536]。

End(xlUp).Row To i + 1 Step —1If Cells(i， 1)。

Value = Cells（j， 1）.Value ThenRows（i)。

DeleteEnd IfNextNextEnd SubSub RemoveItem()'删除相邻重复，但不删除隔行重复Dim i As LongWith Range（"A2”）’以A2为基准进行单元格偏移Do While .Offset(i, 0)If .Offset（i， 0)。

Value = .Offset（i — 1, 0）。

Value Then 。

Offset（i, 0）.EntireRow.Delete i = i + 1LoopEnd WithEnd Sub2.ActiveX控件的相关操作关键字：ActiveX、OLEObjects、ActiveSheet。

OLEObjects遍历控件Dim c As ObjectFor Each c In ActiveSheet.OLEObjectsIf = ”ComboBox” & i Then’…………。