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