欢迎访问服务器技术网-www.fuwuqijishu.com

如何将一个excel表的内容按各部门拆分多个sheet表

软件 fuwuqijishu 2年前 (2022-10-01) 10次浏览 0个评论 扫描二维码

关于搜过之前提问的解答,但是veb设置的有问题一直报错。还请高手留下邮箱我输出附件,请帮忙指点!万分感谢!的问题

使用VBA是很简单的问题,能否将你的VBA代码发上来帮你看看错在哪儿?
使用下面的代码看看有没有问题:
在工作表名称上点右键选查看代码,粘贴以下代码到弹出窗口。关闭弹出窗口 ALT F8选中该宏执行
Sub 拆分工作表()
Application。
ScreenUpdating = False
Dim rng As Range, arr()
endrow = Range(“A65536”)。End(xlUp)。Row
ReDim arr(2, 0)
arr(0, 0) = Range(“A2”)。
Value
arr(1, 0) = Range(“A2”)。Row
arr(2, 0) = Range(“A2”)。Row
L = 0
For i = 2 To endrow
temp = Range(“A” & i)。
Value
For ii = i 1 To endrow
With Range(“A” & ii)
If 。Value = temp Then
arr(2, L) = 。
Row
Else
L = L 1
ReDim Preserve arr(2, L)
arr(0, L) = 。
Value
arr(1, L) = 。Row
arr(2, L) = 。Row
i = 。
Row – 1
Exit For
End If
End With
Next
Next
For i = 0 To L
Workbooks。
Add
ActiveWorkbook。SaveAs ThisWorkbook。Path & “” & arr(0, i)
ActiveSheet。Name = arr(0, i)
ActiveSheet。
Range(“A:C”)。ColumnWidth = 10
ActiveSheet。Range(“A:C”)。HorizontalAlignment = xlCenter
ActiveSheet。
Range(“A:C”)。VerticalAlignment = xlCenter
ActiveSheet。Range(“C:C”)。NumberFormatLocal = “m-d”
ActiveSheet。
Range(“D:D”)。ColumnWidth = 30
ThisWorkbook。Activate
Workbooks(arr(0, i) & “。xls”)。Sheets(1)。Rows(1)。
Value = Sheet1。Rows(1)。Value
For bc = arr(1, i) To arr(2, i)
Workbooks(arr(0, i) & “。xls”)。
Sheets(1)。Rows(bc – arr(1, i) 2)。Value = Sheet1。Rows(bc)。Value
Next
Workbooks(arr(0, i) & “。
xls”)。Close SaveChanges:=True
Next
Application。ScreenUpdating = True
MsgBox “拆分工作表完成!” & vbCrLf & “在当前工作薄路径下创建工作薄:” & L 1 & “个。

End Sub。

喜欢 (0)
发表我的评论
取消评论
表情 贴图 加粗 删除线 居中 斜体 签到

Hi,您需要填写昵称和邮箱!

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址

Warning: error_log(/www/wwwroot/fuwiqijishu/wp-content/plugins/spider-analyser/#log/log-2605.txt): failed to open stream: No such file or directory in /www/wwwroot/fuwiqijishu/wp-content/plugins/spider-analyser/spider.class.php on line 2900