|
Sub 拆分()
Dim rng As Range
Set sh = ThisWorkbook.Worksheets(1)
r = sh.Cells(Rows.Count, 1).End(xlUp).Row
Dim ar()
ReDim ar(1 To r, 1 To 3)
For i = 1 To r
If InStr(sh.Cells(i, 1), "班") > 0 Then
n = n + 1
ar(n, 1) = i
ar(n, 3) = sh.Cells(i, 1)
End If
If InStr(sh.Cells(i, 1), "平均分") > 0 Then
ar(n, 2) = i
End If
Next i
For i = 1 To n
sh.Copy
With ActiveWorkbook.Worksheets(1)
For s = 1 To r
If s > ar(i, 2) Or s < ar(i, 1) Then
If rng Is Nothing Then
Set rng = .Rows(s)
Else
Set rng = Union(rng, .Rows(s))
End If
End If
Next s
rng.Delete
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(i, 3) & ".xls", FileFormat:=xlExcel8
ActiveWorkbook.Close False
Set rng = Nothing
Next i
MsgBox "ok!"
End Sub
|
|