• 【VBA】VBA编写的,将一列中相同的内容的行提取出来单独生成文件


    数据如上图所示,点击RUN后的运行结果如下:

    得到该文件夹,文件夹内容如上图。

    代码如下:

    Private Sub Command_OLIVER()
        Dim arr
        arr = Range("A1:C" & [a65536].End(3).Row)
    
        Dim i As Long, wName As String, wPath As String
        wName = "分类汇总" & Format(Now(), "hhmmss")
        Dim dc As Object, wb As Workbook, n As Long
        Set dc = CreateObject("Scripting.dictionary")
    
        wPath = ThisWorkbook.Path & "" & wName
        MkDir wPath
        For i = 2 To UBound(arr)
            If Not dc.exists(arr(i, 1)) Then
                Set wb = Workbooks.Add
                wb.SaveAs wPath & "" & arr(i, 1) & ".xls"   '001
                wb.Sheets(1).Name = arr(i, 1)
                '填写表头
                wb.Sheets(1).[a1] = arr(1, 1)
                wb.Sheets(1).[b1] = arr(1, 2)
                wb.Sheets(1).[c1] = arr(1, 3)
                dc.Add arr(i, 1), ""
            End If
            With Workbooks(arr(i, 1) & ".xls").Sheets(1)   '002
                n = .[a65536].End(3).Row + 1
                .Cells(n, 1) = arr(i, 1)
                .Cells(n, 2) = arr(i, 2)
                .Cells(n, 3) = arr(i, 3)
            End With
        Next
    
        Dim ar
        ar = dc.keys
        For i = 0 To UBound(ar)
            Workbooks(ar(i) & ".xls").Close True   '003
        Next
    End Sub

    调用该sub

    Sub 调用()
     Command_OLIVER
    End Sub
    

    注意:必须在同一模块中call该sub,因为上述sub为私有的,局部方法.

    附件下载

     

  • 相关阅读:
    noi.ac NOI挑战营模拟赛1-5
    TJOI2015 弦论
    CQOI2018 破解D-H协议
    NOI2013 矩阵游戏
    NOI2015 荷马史诗
    NOI2015 寿司晚宴
    SDOI2014 重建
    NOI1999 生日蛋糕
    NOI2015 程序自动分析
    ZJOI2008 泡泡堂
  • 原文地址:https://www.cnblogs.com/OliverQin/p/7337482.html
Copyright © 2020-2023  润新知