近来学习VSTO，整合了不少功能，所以少发表文章了。 想整合好了用于自己的工作，方便快速。上个图吧
来个代码：吧
DisAppSet(False)
Dim Actwb As Excel.Workbook = xlapp.ActiveWorkbook
Dim ActSht As Excel.Worksheet = xlapp.ActiveSheet
Dim SavePathStr As String = Actwb.Path "拆分结果"
Dim shtName As String = "射雕英雄传0"
'If ActSht.Name <> shtName Then MsgBox("要打开指定工作表")
Dim Mydic As New Dictionary(Of String, Excel.Range)
Dim TitleRange As Excel.Range
With ActSht
TitleRange = .Rows("1:4")
For index As Integer = 5 To 170
Dim ts As String = .Cells(index, 2).value.ToString()
'MsgBox(index.ToString())
If Mydic.ContainsKey(ts) Then
Mydic(ts) = xlapp.Union(Mydic(ts), .Rows(index))
Else
Mydic.Add(ts, .Rows(index))
End If
Next
End With
'MsgBox(Mydic.Count.ToString() "--" Mydic("神雕侠侣").Count.ToString())
'Dim addwb As Excel.Worksheet = Actwb.Worksheets.Add()
'Mydic("神雕侠侣").Copy(addwb.Cells(1, 1))
'Mydic("神雕侠侣").EntireRow.Delete()
For Each key In Mydic.Keys
'Actwb.Sheets.Add(After:=Actwb.Sheets(Actwb.Sheets.Count))
'ActSht.Copy()
Dim addwb As Excel.Worksheet = Actwb.Worksheets.Add()
With addwb
TitleRange.Copy(.Range("A1"))
Mydic(key).Copy()
.Range("A5").PasteSpecial(Paste:=Excel.XlPasteType.xlPasteAll)
.Name = key
.Move()
End With
xlapp.ActiveWorkbook.SaveAs(Filename:=SavePathStr key)
xlapp.ActiveWorkbook.Close()
Next
DisAppSet(True)
MsgBox("完成")
