您的位置：首页 > 编程语言 > VB

VBA代码拆分excel

2017-08-12 00:22 477 查看

忙活两小时，终于帮老姐实现了拆分工作excel的需求，记录下，说不定以后可以用到。。

需求：一个excel文件工作簿可能包含多个工作表(比如sheetA，sheetB,sheetC),每个sheet里每一行都有一个地市字段，现需要根据地市拆分成不同的excel（每个excel包含sheetA，sheetB,sheetC，而且每个sheet里的记录都是同一个地市的）。

代码如下：
Sub 复制表()
Dim j%
For j = 1 To 21
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".xlsm")(0) & j & ".xlsm"
Next
Call 打开并关闭文件
End Sub
Sub 打开并关闭文件()
Dim wb As Workbook
Dim m

For m = 1 To 21
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".xlsm")(0) & m & ".xlsm", True)

Call 拆分(m)

Sheets("sheet1").Visible = xlSheetVeryHidden

wb.Close True

Next

End Sub
Sub 拆分(m)
Dim B1
Dim k%
k = m
Sheets("KPI").Select
For B1 = 24 To 3 Step -1
If Cells(B1, 1) <> Sheets("sheet1").Range("A" & k).Value Then
Rows(B1 & ":" & B1).Select
Selection.Delete Shift:=xlUp
End If
Next B1

Sheets("大规模断站8月").Select
For B1 = 24 To 3 Step -1
If Cells(B1, 1) <> Sheets("sheet1").Range("A" & k).Value Then
Rows(B1 & ":" & B1).Select
Selection.Delete Shift:=xlUp
End If
Next B1

Sheets("大规模断站明细").Select
B1 = Range("A1").End(xlDown).Row 'b1等于a列有数据最后一行的行号
While Cells(B1, 5) <> "分公司"
If Cells(B1, 5) <> Sheets("sheet1").Range("A" & k).Value Then
Rows(B1 & ":" & B1).Select
Selection.Delete Shift:=xlUp
End If
B1 = B1 - 1
Wend
End Sub

PS：上述代码需要根据实际情况调整！！

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签： 拆分excel

相关文章推荐

新的分享

章节导航