利用excel拆分数据

Posted 2020-08-10 qinqinyang

要求：将sheet1中的数据按照公司名称拆分到不同的工作表

使用VBA：

1：打开sheet1的查看代码

2：运行

······························································································

Sub cfs()

Dim GSArr() As String \'公司名称清单

Dim Rca As Long \'A列数据行数

Dim i As Integer

Dim Sn As String

 

Sn = ActiveSheet.Name

Rca = Columns("A:A").End(xlDown).Row

 

ReDim GSArr(1 To 1)

GSArr(1) = Cells(2, 1)

For i = 3 To Rca

    If IsError(Application.Match(Cells(i, 1), GSArr, 0)) Then

       ReDim Preserve GSArr(1 To UBound(GSArr) + 1)

       GSArr(UBound(GSArr)) = Cells(i, 1)

    End If

Next

 

If ActiveSheet.AutoFilterMode = False Then

    Rows("1:1").AutoFilter

Else

    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

End If

 

For i = 1 To UBound(GSArr)

    ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=GSArr(i)

    Sheets.Add After:=Sheets(Sheets.Count)

    ActiveSheet.Name = GSArr(i)

    Sheets(Sn).Cells.Copy ActiveSheet.Cells

    Sheets(Sn).Activate

Next

ActiveSheet.Cells.AutoFilter

End Sub

·································································································

#如果数据比较多，要将as integer改为as long