Office Excel拆分工具

2022-09-18 09:18:28 字數 4200 閱讀 2491

解決的問題:

其他excel中載入巨集工具,會造成拆分表頭丟失;

第一列前幾行有空執行失敗;

拆分到本工作簿會把除拆分表以外的其他表刪掉,修改為若為拆分欄位裡的表名則刪掉,否則保留。

1、開啟拆分工具表和要拆分的表,啟用要拆分的表視窗(如有彈窗啟用巨集)

2、開發工具——巨集——窗體拆分——執行(若無開發工具tab,在excel選項——自定義功能區開啟)

3、設定拆分型別和行列設定

如果要以多個字段作為分組拆分工作表,可在最前面插入一列,將多個字段連線。拆分完成再刪除第一列即可。

可在後台**中取消注釋刪除第一列的**。

private sub commandbutton1_click()

dim arr as variant

dim header as range

dim i, s as integer

dim brr()

dim wb, wb1 as workbook

dim d as object

set d = createobject("scripting.dictionary")

dim sh as worksheet

if combobox1.text = "" then

msgbox "請輸入標題行數"

exit sub

end if

if combobox2.text = "" then

msgbox "請輸入拆分列"

exit sub

end if

if optionbutton1.value = false and optionbutton2.value = false and optionbutton3.value = false then

msgbox "請選擇拆分型別"

exit sub

end if

'獲取表頭

set header = activesheet.rows("1:" & combobox1.text)

'獲取各區域字典

arr = activesheet.range("a" & combobox1.text + 1).currentregion

for i = combobox1.text + 1 to ubound(arr)

if not d.exists(arr(i, combobox2.text)) then

set d(arr(i, combobox2.text)) = activesheet.range("a" & i).resize(1, ubound(arr, 2))

else

set d(arr(i, combobox2.text)) = union(d(arr(i, combobox2.text)), activesheet.range("a" & i).resize(1, ubound(arr, 2)))

end if

next i

'如果為拆分到本工作簿,原來就存在拆分字段命名的表,則刪除

if optionbutton1.value = true then

for each sh in worksheets

if d.exists(sh.name) then sh.delete

next sh

end if

if optionbutton3.value = true then

set wb1 = workbooks.add

i = 1

for each k in d.keys

wb1.worksheets(i).name = k

i = i + 1

next k

end if

x = d.keys

for k = 0 to ubound(x)

'拆分到本工作簿**

if optionbutton1.value = true then

worksheets.add after:=worksheets(worksheets.count)

activesheet.name = x(k)

header.copy activesheet.[a1]

d.items()(k).copy activesheet.cells(combobox1.text + 1, 1)

'activesheet.columns("a:a").delete shift:=xltoleft '如果拆分完成不保留第一列,取消此行注釋

for i = 1 to ubound(arr, 2)

for each sh in thisworkbook.worksheets

if sh.name <> x(k) then

sheets(x(k)).columns(i).columnwidth = sh.columns(i).columnwidth

end if

next sh

next i

end if

'拆分為多個工作簿**

if optionbutton2.value = true then

set wb = workbooks.add

with wb.worksheets(1)

header.copy .[a1]

d.items()(k).copy .cells(combobox1.text + 1, 1)

.columns("a:a").delete shift:=xltoleft '如果拆分完成不保留第一列,取消此行注釋

for i = 1 to ubound(arr, 2)

.columns(i).columnwidth = thisworkbook.activesheet.columns(i).columnwidth

next i

wb.s**eas filename:=thisworkbook.path & "\" & x(k) & ".xlsx" '此處可設定在分割欄位前或者後加字元組成檔名,也可設定匯出路徑,預設為此巨集工作簿路徑

wb.close

end with

end if

'拆分為乙個工作簿**

if optionbutton3.value = true then

header.copy wb1.worksheets(x(k)).[a1]

d.items()(k).copy wb1.worksheets(x(k)).cells(combobox1.text + 1, 1)

'wb1.worksheets(x(k)).columns("a:a").delete shift:=xltoleft '如果拆分完成不保留第一列,取消此行注釋

for i = 1 to ubound(arr, 2)

wb1.sheets(x(k)).columns(i).columnwidth = thisworkbook.activesheet.columns(i).columnwidth

next i

end if

next k

if optionbutton3.value = true then

wb1.s**eas filename:=thisworkbook.path & "\" & "拆分資料表.xlsx" '此處可設定匯出檔名和匯出路徑,預設為此巨集工作簿路徑

wb1.close false

end if

endend sub

private sub commandbutton2_click()

endend sub

private sub userform_initialize()

me.combobox1.list = array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")

me.combobox2.list = array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26")

end sub

json 文件拆分工具 JSON 資料拆分

這是在資料提交時遇到的問題。我準備的資料結構是這樣的 path test clients client 1.2.2.2 1.1.1.1 access type 2,name test 01 client 1.2.2.4 1.1.1.4 access type 1,name test 02 clien...

幫公司人事MM做了個工資條拆分工具

偶爾一次午飯時人事說加班加到8點多,純手工複製貼上excel的內容,公司大概150多人吧,每次發工資時都需要這樣手動處理,將乙個excel拆分成150多個excel,再把裡面的內容粘過去,如此迴圈。於是,我寫了個小程式幫人事mm解決。主要是用到了npoi生成excel,根據每條記錄建立乙個excel...

Python 效能剖分工具

眼看著專案即將完成,卻被測試人員告知沒有通過效能測試,這種情況在開發中屢見不鮮。接下來的工作就是加班加點地找出效能瓶頸,然後進行優化,再進行效能測試,如此這般周而復始直到通過效能測試。儘管豐富的工作經驗有助於效能優化,但只有科學地應用工具才能在最短的時間內找出最佳優化粒度的瓶頸 段,達到事半功倍的效...