當前位置:成語大全網 - 新華字典 - excel中將壹張表中數據拆分成多個工作表,按承攬人姓名不相同的拆分成單個工作表

excel中將壹張表中數據拆分成多個工作表,按承攬人姓名不相同的拆分成單個工作表

Sub?如何將壹個Excel工作表的數據拆分成多個工作表()

Dim?Arr,?Rng?As?Range,?Sht?As?Worksheet,?Dic?As?Object

Dim?k,?t,?Str?As?String,?i?As?Long,?lc?As?Long

Application.ScreenUpdating?=?False?'關閉屏幕更新

Arr?=?Range("A1").CurrentRegion.Value

lc?=?UBound(Arr,?2)?'求取最後壹列的列號

Set?Rng?=?Rows(1)?'標題行

Set?Dic?=?CreateObject("Scripting.Dictionary")?'創建字典

For?i?=?2?To?UBound(Arr)

Str?=?Arr(i,?3)?'承攬人姓名,關鍵字

If?Not?Dic.Exists(Str)?Then?'如果字典沒有關鍵字

Set?Dic(Str)?=?Cells(i,?1).Resize(,?lc)?'把當前行裝入到字典中

Else?'否則(字典中存在關鍵字)

Set?Dic(Str)?=?Union(Dic(Str),?Cells(i,?1).Resize(,?lc))?'把行連合起來

End?If

Next

k?=?Dic.Keys?'字典關鍵字集合

t?=?Dic.Items?'字典項目集合

On?Error?Resume?Next

With?Sheets

For?i?=?0?To?Dic.Count?-?1?'循環關鍵字的個數

Set?Sht?=?.Item(k(i))?'給變量賦值(工作表名為關鍵字)

If?Sht?Is?Nothing?Then?'該工作表不存在則插入壹個空工作表

.Add(After:=.Item(.Count)).Name?=?k(i)?'新建的工作表將置於所有工作表之後,並命名為關鍵字

Set?Sht?=?ActiveSheet?'活動工作表給變量

Else?'否則

Sht.Cells.Clear?'清除工作中所有內容和格式

End?If

Rng.Copy?Sht.Range("A1")?'把標題寫入第壹行

t(i).Copy?Sht.Range("A2")?'寫入其他內容

Sht.Cells.EntireColumn.AutoFit?'自動調整全工作表單元格的列寬

Set?Sht?=?Nothing?'變量處於初始狀態

Next

End?With

Sheets(1).Activate?'第1個工作表處於激活狀態

Application.ScreenUpdating?=?True?'打開屏幕更新

End?Sub

假如承攬人姓名在C列