excel常用宏

1.拆分单元格赋值Sub拆分填充()DimxAsRangeForEachxInActiveSheet.UsedRange.CellsIfx.MergeCellsThenx.Selectx.UnMergeSelection.Value=x.ValueEndIfNextxEndSub2.Excel宏按列拆分多个excelSubMacro1()DimwbAsWorkbook,arr,rngAsRange,dAsObject,k,t,shAsWorksheet,i&Setrng=Range(A1:f1)Application.ScreenUpdating=FalseApplication.DisplayAlerts=Falsearr=Range(a1:a&Range(b&Cells.Rows.Count).End(xlUp).Row)Setd=CreateObject(scripting.dictionary)Fori=2ToUBound(arr)IfNotd.Exists(arr(i,1))ThenSetd(arr(i,1))=Cells(i,1).Resize(1,13)ElseSetd(arr(i,1))=Union(d(arr(i,1)),Cells(i,1).Resize(1,13))EndIfNextk=d.Keyst=d.ItemsFori=0Tod.Count-1Setwb=Workbooks.Add(xlWBATWorksheet)Withwb.Sheets(1)rng.Copy.[A1]t(i).Copy.[A2]EndWithwb.SaveAsFilename:=ThisWorkbook.Path&\&k(i)&.xlsxwb.CloseNextApplication.DisplayAlerts=TrueApplication.ScreenUpdating=TrueMsgBox完毕EndSub3.Excel宏按列拆分多个sheet在一个工作表中是许多的公司订单记录，如何将它按公司名分拆成一个个工作表，用VBA实现相当便捷。以下是演试：原始工作簿：运行VBA代码后的工作簿：代码如下：1.需要先把数据按照分拆的那一列字段排序2.如果你想应用在你的表格中，只需将所有resize(1,3)中的3修改，改成你的表格的列数。如果你总表有8列就改成resize(1,8)即可3.如果你想根据表格的第一列拆分，需要把Sheet1.Cells(i,2)Sheet1.Cells(i-1,2)和sh.Name=Sheet1.Cells(i,2)的2换成1Subs()Application.ScreenUpdating=FalseDimshAsWorksheet,iAsIntegerFori=2ToSheet1.[a65536].End(3).RowIfSheet1.Cells(i,2)Sheet1.Cells(i-1,2)ThenWorksheets.Addafter:=Worksheets(Sheets.Count)Setsh=ActiveSheetsh.Name=Sheet1.Cells(i,2)sh.Range(a1).Resize(1,3).Value=Sheet1.Range(a1).Resize(1,3).Valuesh.Range(a65536).End(3).Offset(1,0).Resize(1,3).Value=Sheet1.Cells(i,1).Resize(1,3).ValueElsesh.Range(a65536).End(3).Offset(1,0).Resize(1,3).Value=Sheet1.Cells(i,1).Resize(1,3).ValueEndIfNextiApplication.ScreenUpdating=TrueEndSub4.Excel宏多工作表合并FunctionLastRow(shAsWorksheet)OnErrorResumeNextLastRow=sh.Cells.Find(what:=*,_After:=sh.Range(A1),_Lookat:=xlPart,_LookIn:=xlFormulas,_SearchOrder:=xlByRows,_SearchDirection:=xlPrevious,_MatchCase:=False).RowOnErrorGoTo0EndFunctionSubs()DimshAsWorksheetDimDestShAsWorksheetDimLastAsLongDimshLastAsLongDimCopyRngAsRangeDimStartRowAsLongApplication.ScreenUpdating=FalseApplication.EnableEvents=False'新建一个“汇总”工作表Application.DisplayAlerts=FalseOnErrorResumeNextActiveWorkbook.Worksheets(汇总).DeleteOnErrorGoTo0Application.DisplayAlerts=TrueSetDestSh=ActiveWorkbook.Worksheets.AddDestSh.Name=汇总'开始复制的行号，忽略表头，无表头请设置成1StartRow=2ForEachshInActiveWorkbook.WorksheetsIfsh.NameDestSh.NameThenLast=LastRow(DestSh)shLast=LastRow(sh)IfshLast0AndshLast=StartRowThenSetCopyRng=sh.Range(sh.Rows(StartRow),sh.Rows(shLast))IfLast+CopyRng.Rows.CountDestSh.Rows.CountThenMsgBox内容太多放不下啦！GoToExitSubEndIfCopyRng.CopyWithDestSh.Cells(Last+1,A).PasteSpecialxlPasteValues.PasteSpecialxlPasteFormatsApplication.CutCopyMode=FalseEndWithEndIfEndIfNextExitSub:Application.GotoDestSh.Cells(1)DestSh.Columns.AutoFitApplication.ScreenUpdating=TrueApplication.EnableEvents=TrueEndSub5.多个sheet拆成多个excelSubMacro1()DimshtAsWorksheetApplication.ScreenUpdating=FalseApplication.DisplayAlerts=FalseForEachshtInSheetssht.CopyActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path&\&sht.Name&.xlsxActiveWorkbook.CloseNextApplication.DisplayAlerts=TrueApplication.ScreenUpdating=TrueEndSub或者PrivateSub分拆工作表()DimshtAsWorksheetDimMyBookAsWorkbookSetMyBook=ActiveWorkbookForEachshtInMyBook.Sheetssht.CopyActiveWorkbook.SaveAsFilename:=MyBook.Path&\&sht.Name,FileFormat:=xlNormal'将工作簿另存为EXCEL默认格式ActiveWorkbook.CloseNextMsgBox文件已经被分拆完毕!EndSub6.利用txt提取文件夹中的所有文件名称1、在那个文件夹内新建一个.TXT文件（如wenjian.txt），用记事本单开输入dir1.txt保存退出将刚才的.TXT（wenjian.txt）更名为.bat文件（wenjian.bat）双击wenjian.bat文件运行一次，在文件夹内多出一个1.txt文件打开1.txt文件，将其中的内容粘贴到Excel中，数据——分列处理就可以得到你要的文件名列表了！7.一列拆成两列Excel电子表格的功能非常强大，无论是拆分还是合并单元格都可以轻松完成。有时候我们编辑数据的时候将“名称”和“价格”全部放到了一个单元格中了，有什么方法可以快速将这些数据拆分开呢？下面Word联盟以具体实例来为大家详细介绍操作方法。Excel表格中的数据拆分案例说明：水果名称与水果价格全部在一个单元格中，只是用“空格”分隔开。我们将这些以空格分隔开的数据分别拆分到两个单元格中。①首先，我们在Excel表格中选中需要拆分的列；②然后，单击菜单栏的“数据”，在下拉列表中选择“分列”命令；③此时，需要3个步骤来完成数据在表格中的拆分，“文本分列向导-3步骤之1”，我们只需选择默认的“分割符号”再单击下面的“下一步”按钮；④然后，继续在“文本分列向导-3步骤之2”下面的“分隔符号”中勾选“Tab键”、“空格”和“连续分隔符号视为单个处理”。（现在我们可以在“数据预览”中看到拆分的效果）最后单击“下一步”；⑤最后一个步骤，我们单击“完成”就可以了。拆分好的表格效果如下图所示：提示：以上的表格数据拆分工作必须要有一定的规律才可以实现，比如文字与数字之间有空格或者逗号、分号等其他任何符号或有规律的字符都可以完成拆分工作。如果中间没空格或者有规律的字符，那么这项拆分数据表格的工作就无法实现了。8.根据颜色不同做IF判断如果有很多种颜色，可以插入一列公式=颜色，将颜色值求出在取值列用公式=IF(颜色=6,1050,IF(颜色=0,L2))，如果有多种颜色，就再加多层IF9.一个工作薄中有许多工作表如何快速整理出一个目录工作表1、用宏3.0取出各工作表的名称，方法：Ctrl+F3出现自定义名称对话框，取名为X，在“引用位置”框中输入：=MID(GET.WORKBOOK(1),FIND(],GET.WORKBOOK(1))+1,100)确定2、用HYPERLINK函数批量插入连接，方法：在目录工作表（一般为第一个sheet）的A2单元格输入公式：=HYPERLINK(#'&INDEX(X,ROW())&'!A1,INDEX(X,ROW()))将公式向下填充，直到出错为止，目录就生成了。10.常用公式计算有值的单元格的平均值=AVERAGEIF(C8:T8,0)子列排序=IF(A2=A1,C1+1,1)数字转字母=CHAR(A57+64)字母转数字=CODE(B58)-64截取=MID(B5,3,99)分类=IF(A2=A1,B1,B1+1)查找=VLOOKUP(C:C,'5.2-大中型建筑业打分卡问题清单'!B:D,3,0)数数=COUNTIF(I:I,√)A列相同的F列值和=SUMIF(A:A,A2,F:F)倒序=INDEX($A$1:$A$119,ROWS($A$1:$A$119)-ROWS($A$1:A1)+1)两个相同再取值=VLOOKUP(A2&$B$1,Sheet4!$B:$J,9,0)改名=CHOOSE(MATCH(,0/FIND({1A,1B,2A,2B,3A,3B,4A,4B,5A,5B,6A,6B,7A,7B,8A,8B},N358),),是,是,是,是,是,是,是,是,是,是,是,是,是,是,是,是)改日期格式：=TEXT(A4,yyyy/m/dd)=TEXT(B4,HH:MM)双重条件统计个数=SUMPRODUCT(($B$3:$AK$3=AM$3)*($B4:$AK4=√))=COUNTIFS($B$3:$AK$3,AM$3,$B4:$AK4,√)1、查找重复内容公式