文档供参考，可复制、编制，期待您的好评与关注！ C:Documents and SettingsAdministratorMy DocumentsTencent Files1061098244FileRecv合并当前工作簿下的所有工作表Alt +F11Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.CountIf Sheets(j).Name ActiveSheet.Name Thenx = Range(A65536).End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(x, 1)End IfNextRange(B1).SelectApplication.ScreenUpdating = TrueMsgBox 当前工作簿下的全部工作表已经合并完毕！, vbInformation, 提示End Sub合并两个单元格内容如果你要的结果是“adcd”，公式就是：=1号单元格内容&2号单元格内容如果你要的结果是“ad*cd”，公式就是：=1号单元格内容&*&2号单元格内容身份证提取日期Mid（）根据条件匹配数据Vlookup(a1,sheet,0)排序Rank（a1，a1:a6，0）随机数要产生的随机数，可以输入=INT(25*RAND()+1如果是两列数据进行对比（即对2列所有的数据进行对比）：在C1输入=IF(COUNTIF(A:A,D1)=1,同样,不一样)然後下拉即可查找A列与D列的不一样数据。在E1输入=IF(COUNTIF(A:A,E1)=1,同样,不一样)然後下拉即可查找B列与E列的不一样数据。统计一列数据中重复的有几个用COUNTIF函数比如你的名称在A列，在A列以外的任意区域输入公式：=COUNTIF(A:A,张三)统计“张三”这个名称的数量。假设你的数据在A列和B列,那你在C1单元格中输入公式=IF(A1=B1,相同,),公式的意思是说,如果A1等于B1,则在C1中显示相同,如果两个单元格的数据不相等,则显示为空白单元格.身份证号中提取出生年月= MID(J11, 7, 4) & 年 & MID(J11, 11, 2) & 月 & MID(J11, 13, 2)&日拆分当前工作簿下的所有工作表http:/jingyan.baidu.com/article/d7130635071d2313fdf47585.htmlAlt+F11的快捷键进入VBE编辑界面要注意下面第一个步骤，要拆分的数据工作表名称为“数据源”，而不是你新建工作簿时的sheet1这种。手动改成“数据源”即可。插入模块，粘贴代码。 工具宏 注意：1）原始数据表要从第一行开始有数据，并且不能有合并单元格；2）打开工作簿时需要开启宏，否则将无法运行代码。Sub CFGZB() Dim myRange As Variant Dim myArray Dim titleRange As Range Dim title As String Dim columnNum As Integer myRange = Application.InputBox(prompt:=请选择标题行：, Type:=8) myArray = WorksheetFunction.Transpose(myRange) Set titleRange = Application.InputBox(prompt:=请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”, Type:=8) title = titleRange.Value columnNum = titleRange.Column Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i&, Myr&, Arr, num& Dim d, k For i = Sheets.Count To 1 Step -1 If Sheets(i).Name 数据源 Then Sheets(i).Delete End If Next i Set d = CreateObject(Scripting.Dictionary) Myr = Worksheets(数据源).UsedRange.Rows.Count Arr = Worksheets(数据源).Range(Cells(2, columnNum), Cells(Myr, columnNum) For i = 1 To UBound(Arr) d(Arr(i, 1) = Next k = d.keys For i = 0 To UBound(k) Set conn = CreateObject(adodb.connection) conn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= & ThisWorkbook.FullName Sql = select * from 数据源$ where & title & = & k(i) & Worksheets.Add after:=Sheets(Sheets.Count) With ActiveSheet .Name = k(i) For num = 1 To UBound(myArray) .Cells(1, num) = myArray(num, 1) Next num .Range(A2).CopyFromRecordset conn.Execute(Sql) End With Sheets(1).Select Sheets(1).Cells.Select Selection.Copy Worksheets(Sheets.Count).Activate ActiveSheet.Cells.Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Next i conn.Close Set conn = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = TrueEnd Sub本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表。注意：很多朋友反映sheets(i).delete这句代码出错，excel中首先将该列设为文本字段，左对齐后，再导出到dbf文件试试。如果还有空格，在vfp中用以下命令：repl all 字段名 with allt(字段名)可以彻底消除空格 /