將一個Excel表格分割成每個sheet包含300行的宏

把一個excel的sheet分成每300行一個sheet的巨集！

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中文網其他相關文章！