如何一列拆分工作表并保存(第三列表)

非洲人233

于 2018-06-11 19:42:14 发布

阅读量846

点赞数

CC 4.0 BY-SA版权

分类专栏：笔记文章标签： VBA

本文链接：https://blog.youkuaiyun.com/kevin_7july/article/details/80656877

笔记专栏收录该内容

24 篇文章

订阅专栏

本文介绍了一段VBA代码，该代码可以将Excel工作表中的数据按C列的唯一值拆分成多个独立的工作簿文件，每个文件以C列的唯一值命名，并包含与之对应的数据行。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

    Sub 分拆工作表()
      Dim r%, i%
      Dim arr, brr
      Dim d As Object
      Dim wb As Workbook
      Dim ws As Worksheet
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Application.SheetsInNewWorkbook = 1
      Set d = CreateObject("scripting.dictionary")
      With Worksheets("sheet1")
        r = .Cells(.Rows.Count, 4).End(xlUp).Row
        arr = .Range("c1:c" & r)
        For i = 2 To UBound(arr)
          If Not d.exists(arr(i, 1)) Then
            Set d(arr(i, 1)) = .Cells(1, 1).Resize(1, 69)
          End If
          Set d(arr(i, 1)) = Union(d(arr(i, 1)), .Cells(i, 1).Resize(1, 69))
        Next
      End With
      For Each aa In d.keys
        Set wb = Workbooks.Add
        With wb
          With .Worksheets("sheet1")
            .Name = aa
            d(aa).Copy .Range("a1")
          End With
          .SaveAs Filename:=ThisWorkbook.Path & "\" & aa & ".xlsx"
          .Close False
        End With
      Next
    End Sub