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

excel中,用VBA编写的,将A列中相同的内容的行提取出来单独生成新的excel文件,生成的文件名为A列的内容。生成的文件最好自带表头... excel中,用VBA编写的,将A列中相同的内容的行提取出来单独生成新的excel文件,生成的文件名为A列的内容。
生成的文件最好自带表头
展开
 我来答
unsamesky
2014-11-18 · TA获得超过2735个赞
知道小有建树答主
回答量:859
采纳率:100%
帮助的人:433万
展开全部

代码如下:

如果你是2003以上版本的Excel,那么请将上面三个地方的.xls更换成.xlsx

详细可下载附件测试,新文件在新建的以时间命名的“分类汇总”文件夹内。

Private Sub CommandButton1_Click()
    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


追问
谢谢大神,想问下,这个是对比A列相同的,如果想换C列或者D列修改哪里可以实现。
追答
arr(i,1),arr(i,2),arr(i,3),这里的1,2,3就表示A,B,C列,但是你涉及的列众多,你要修改的话,一定要很仔细的别把列弄错了,不然数据就完全统计错误了!
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式