将一个Excel表格分割成每个sheet包含300行的宏

将一个Excel表格分割成每个sheet包含300行的宏

Public Sub mySub()

Dim shS As Worksheet: Set shS = ActiveSheet '源数据表，当前活动表

Dim rS&: rS = 1 '源数据表，从这行开始读取数据

Dim rC&: rC = 300 '每次读取的行数

Dim rNew$: rNew = 1 '新建表内，数据粘贴到这行

Dim rZ&: rZ = shS.UsedRange.Row + shS.UsedRange.Rows.Count - 1

Dim shNew As Worksheet, nm$, n%, r&

r = rS

Do While r

n = n + 1

Set shNew = Worksheets.Add(after:=Sheets(Worksheets.Count))

nm = ＂表 ＂ & rC & ＂_＂ & n

Call ShNm(shNew, nm)

shS.Rows(r).Resize(rC).Copy shNew.Rows(rNew)

r = rC * n + rS

Loop

MsgBox ＂ok＂

End Sub

Public Sub ShNm(sh As Worksheet, nm As Variant)

On Error Resume Next

100:

sh.Name = nm

If Err.Number 0 Then

Err.Clear

nm = Application.InputBox( _

＂《 ＂ & nm & ＂ 》已经存在！＂ & Chr(10) & Chr(10) & ＂请输入新表名：＂， _

＂请输入新表名＂， nm & ＂_new＂, _

Type:=2)

If nm = False Then MsgBox ＂输入不正确，退出程序！＂： End

GoTo 100

End If

End Sub

在EXCEL中如何利用宏命令将一个数列拆开例如将PL10 120拆分成

Sub Macro6()

'

' Macro6 Macro

'

'

Selection.TextToColumns Destination:=Range(＂A1＂), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _

:=＂*＂, FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Columns(＂A:A＂).Select

Selection.Replace What:=＂PL＂, Replacement:=＂＂, LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Columns(＂C:D＂).Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range(＂C1＂).Select

ActiveCell.FormulaR1C1 = ＂=MIN(RC[-2],)＂

Range(＂C1＂).Select

ActiveCell.FormulaR1C1 = ＂=MIN(RC[-2],RC[-1])＂

Range(＂D1＂).Select

ActiveCell.FormulaR1C1 = ＂=MAX(RC[-3],RC[-2])＂

Range(＂C1:D1＂).Select

Selection.AutoFill Destination:=Range(＂C1:D1000＂)

Range(＂C:D＂).Select

Columns(＂A:B＂).Select

Range(＂B1＂).Activate

Columns(＂C:D＂).Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Columns(＂A:B＂).Select

Range(＂B1＂).Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlToLeft

Columns(＂A:B＂).Select

Selection.Replace What:=＂0＂, Replacement:=＂＂, LookAt:=xlWhole, _

_

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

End Sub

注意：使用时先选中A列再运行宏，被分裂列必须在A列哦，而且BC两列是空的，不然会覆盖掉（呵呵时间短，做的不是特别智能）而且行数不超过1000行。呵呵不然会有点慢所以范围就定了1000行。你也是搞钢结构的？哈偶也是哦

EXCEL如何用宏批量在表中把带A有这些的自动符号的拆分到后面列

Option Explicit

Sub test()

Dim rng As Range

Dim arr As Variant

Dim k As Integer

For Each rng In Selection

rng.Value = Replace(rng.Value, ＂:＂, ＂/＂)

arr = Split(rng.Value, ＂/＂)

k = UBound(arr) + 1

rng.Resize(1, k) = arr

Erase arr

Next rng

End Sub关于怎么粘贴代码我估计你会，就不啰嗦了，按下图运行我给你写的代码就可以了：

step-1

step-2

step-3

step-4

如何快速把1个excel表拆分成多个excel表并且保留原有的公式

点击【开发工具】-【Visual Basic】或者Alt+F11的快捷键进入VBE编辑界面。

选择插入一个新的模块

粘贴下列代码在模块中：

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

以上是将一个Excel表格分割成每个sheet包含300行的宏的详细内容。更多信息请关注PHP中文网其他相关文章！