基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 1 元　

支付宝支付

微信支付

   源码介绍

---

基于 Microsoft.Office.Interop 实现拆分

Imports Microsoft.Office.Interop

Public Class Form1

  Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    TopMost = True
    Dim xlapp As Excel.Application
    Dim xlbook As Excel.Workbook
    Dim xlsht As Excel.Worksheet
    xlapp = New Excel.Application With {
      .Visible = True
    }
    xlbook = xlapp.Workbooks.Open(Application.StartupPath & "\Excel.xlsx")
    xlsht = xlbook.Worksheets("订单明细表")
    With xlsht
      Dim arr As Array = .Range("A3:H" & .Range("A65536").End(Excel.XlDirection.xlUp).Row).Value

      Dim DIC As New Dictionary(Of String, String)

      Dim arr_ct As Integer = UBound(arr)
      Dim arr_cvt As Integer = UBound(arr, 2)

      For I As Integer = 1 To arr_ct
        If DIC.ContainsKey(arr(I, 3)) = False Then
          DIC.Add(arr(I, 3), 0)
        End If
      Next
      For Each key In DIC.Keys
        xlbook.Worksheets.Add.name = key
        Dim sht As Excel.Worksheet = xlbook.Worksheets(key)
        For j As Integer = 1 To arr_ct
          Application.DoEvents()
          If arr(j, 3) = key Then
            Dim RW As Integer = sht.Range("A65536").End(Excel.XlDirection.xlUp).Row
            For k As Integer = 1 To arr_cvt
              Application.DoEvents()
              sht.Cells(RW   1, k) = arr(j, k)
            Next
          End If
        Next
      Next


      MsgBox("表拆分完成!")


    End With

  End Sub
End Class