一。執行按條件分類
Sub 分類()
Dim sh As Worksheet, d As Object, ary, aryB, sjl As Long, fenlei
sjl = [a65536].End(3).Row
Set d = CreateObject("scripting.dictionary")
ary = Range("A2:J" & sjl)
For i = 1 To sjl - 1
d(ary(i, 10)) = ""
Next
aryB = d.keys
For fenlei = LBound(aryB) To UBound(aryB)
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh.Name = aryB(fenlei)
Sheet1.Range("1:2").Copy sh.Range("1:2")
For sj = 2 To sjl
cc = Application.CountA(sh.Range("A:A")) + 1
If ary(sj - 1, 10) = aryB(fenlei) Then
Sheet1.Rows(sj).Copy sh.Rows(cc)
End If
Next sj
Next fenlei
End Sub
二。洗掉除1以外的作業表
Sub 洗掉除1以外的作業表()
l = Sheets.Count
For i = l To 2 Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Next
End Sub
1.將上面代碼修改，使得在執行分類的同時洗掉除1以外的作業表，即只要一個步驟就可以同時實作上述兩個功能。
2.標題行有2行，從第3行開始分類，上述代碼似乎從第2行開始分類，怎么改啊
uj5u.com熱心網友回復：
Sub 合并后()
Dim sh As Worksheet, d As Object, ary, aryB, sjl As Long, fenlei
sjl = [a65536].End(3).Row
Set d = CreateObject("scripting.dictionary")
ary = Range("A2:J" & sjl)
For i = 1 To sjl - 1
d(ary(i, 10)) = ""
Next
aryB = d.keys
For fenlei = LBound(aryB) To UBound(aryB)
Set sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh.Name = aryB(fenlei)
Sheet1.Range("1:2").Copy sh.Range("1:2")
For sj = 2 To sjl
cc = Application.CountA(sh.Range("A:A")) + 1
If ary(sj - 1, 10) = aryB(fenlei) Then
Sheet1.Rows(sj).Copy sh.Rows(cc)
End If
Next sj
Next fenlei
l = Sheets.Count
For i = l To 2 Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/96712.html
標籤：VBA