excel常用宏概念.docVIP

拆分单元格赋值 Sub 拆分填充()Dim x As RangeFor Each x In ActiveSheet.UsedRange.CellsIf x.MergeCells Thenx.Selectx.UnMergeSelection.Value = x.ValueEnd IfNext xEnd Sub Excel?宏?按列拆分多个excel Sub Macro1()? ? Dim wb As Workbook, arr, rng As Range, d As Object, k, t, sh As Worksheet, i? ? Set rng = Range(A1:f1)? ? Application.ScreenUpdating = False? ? Application.DisplayAlerts = False? ? arr = Range(a1:a Range(b Cells.Rows.Count).End(xlUp).Row)? ? Set d = CreateObject(scripting.dictionary)? ? For i = 2 To UBound(arr)? ?? ???If Not d.Exists(arr(i, 1)) Then? ?? ?? ?? ?Set d(arr(i, 1)) = Cells(i, 1).Resize(1, 13)? ?? ???Else? ?? ?? ?? ?Set d(arr(i, 1)) = Union(d(arr(i, 1)), Cells(i, 1).Resize(1, 13))? ?? ???End If? ? Next? ? k = d.Keys? ? t = d.Items? ? For i = 0 To d.Count - 1? ?? ???Set wb = Workbooks.Add(xlWBATWorksheet)? ?? ???With wb.Sheets(1)? ?? ?? ?? ?rng.Copy .[A1]? ?? ?? ?? ?t(i).Copy .[A2]? ?? ???End With? ?? ???wb.SaveAs Filename:=ThisWorkbook.Path \ k(i) .xlsx? ?? ???wb.Close? ? Next? ? Application.DisplayAlerts = True? ? Application.ScreenUpdating = True? ? MsgBox 完毕End Sub Excel?宏?按列拆分多个sheet 在一个工作表中是许多的公司订单记录，如何将它按公司名分拆成一个个工作表，用VBA实现相当便捷。以下是演试：原始工作簿：运行VBA代码后的工作簿：代码如下： 需要先把数据按照分拆的那一列字段排序 如果你想应用在你的表格中，只需将所有resize(1,3)中的3修改，改成你的表格的列数。如果你总表有8列就改成resize(1,8)即可 如果你想根据表格的第一列拆分，需要把Sheet1.Cells(i, 2) Sheet1.Cells(i - 1, 2)和sh.Name = Sheet1.Cells(i, 2)的2换成1 Sub s()??Application.ScreenUpdating = False??Dim sh As Worksheet, i As Integer????For i = 2 To Sheet1.[a65536].End(3).Row??????If?Sheet1.Cells(i, 2) Sheet1.Cells(i - 1, 2)?Then????????Worksheets.Add after:=Worksheets(Sheets.Count)??????????Set sh = ActiveSheet????????????sh.Name = Sheet1.Cells(i, 2)????????????sh.Range(a1).Resize(1, 3).Value = Sheet1.Range(a1).Resize(1, 3).Value????????????sh.Range(a65536).End(3).Offset(1, 0).Resize(1, 3).Value = Sheet1.Cells(i, 1).Resize(1, 3).Value??????????Else????????????sh.Range(a65536).End(3).Offset(1, 0).Resize(1, 3).Value = She