答:如果已經創建好了sheet2、sheet3、sheet4這3張表,可以下面代碼:
Sub?demo1()Dim?d?As?Object
Dim?i?As?Long
Dim?Rng?As?Range
Set?Rng?=?Range("A1").CurrentRegion
Set?d?=?CreateObject("scripting.dictionary")
For?i?=?2?To?Cells(Rows.Count,?"C").End(xlUp).Row
d(Cells(i,?"C").Value)?=?""
Next
Application.ScreenUpdating?=?False
For?i?=?0?To?d.Count?-?1
With?Rng
.AutoFilter?3,?Filter(d.keys,?"")(i)
.SpecialCells(xlCellTypeVisible).Copy
Select?Case?Filter(d.keys,?"")(i)
Case?"壹組"
Sheets("Sheet2").Paste?Sheets("Sheet2").Range("A1")
Case?"二組"
Sheets("Sheet3").Paste?Sheets("Sheet3").Range("A1")
Case?"三組"
Sheets("Sheet4").Paste?Sheets("Sheet4").Range("A1")
End?Select
End?With
Next
Rng.AutoFilter
Application.ScreenUpdating?=?True
End?Sub
如是直接分割到3張新工作中去,可以下面代碼
Sub?demo2()Dim?d?As?Object
Dim?i?As?Long
Dim?Rng?As?Range?
Set?Rng?=?Range("A1").CurrentRegion
Set?d?=?CreateObject("scripting.dictionary")
For?i?=?2?To?Cells(Rows.Count,?"C").End(xlUp).Row
d(Cells(i,?"C").Value)?=?""
Next
Application.ScreenUpdating?=?False
For?i?=?0?To?d.Count?-?1
With?Rng
.AutoFilter?3,?Filter(d.keys,?"")(i)
.SpecialCells(xlCellTypeVisible).Copy
With?Sheets.Add
.Paste?.Range("A1")
End?With
End?With
Next
Rng.AutoFilter
Application.ScreenUpdating?=?True
End?Sub