工作簿拆分出现的问题

chj6533 · 发表于 2022-12-28 21:48

各位老师好：

   正在自学VBA窗体，遇到缠人的问题，如有兴趣就帮着求个解。
   做了个窗体+工作簿拆分的代码，说明如下。
1. 此代码的非窗体过程，在别的地方试验，能够完美实现要求。
2.结合窗体后，第一次打开文件，运行不正常，主要体现在
   a，拆分文件无内容,
   b 拆分的部分条目加到程序所在工作簿sheets(“总表”)表里了，
   c，程序所在工作簿的sheets(“总表”)的名称也被修改为设定分表的工作表名了。
3. 手动加断点就能运行正常。

xiaoyuemt · 发表于 2022-12-28 23:06

只是按钮点击没有反应，换了个就好了。能正常运行出表。
分表目录下是运行的结果。

abc123281 · 发表于 2022-12-28 23:19

哦，是个女生呀

chj6533 · 发表于 2022-12-29 00:55

xiaoyuemt 发表于 2022-12-28 23:06
只是按钮点击没有反应，换了个就好了。能正常运行出表。
分表目录下是运行的结果。

2.结合窗体后，第一次打开文件，运行不正常，主要体现在
   a，拆分文件无内容,
   b 拆分的部分条目加到程序所在工作簿sheets(“总表”)表里了，
   c，程序所在工作簿的sheets(“总表”)的名称也被修改为设定分表的工作表名了。
3. 手动加断点就能运行正常。
   本来是可以。只是重新打开表再运行是有问题的。劳驾再琢磨下，谢谢！

chj6533 · 发表于 2022-12-29 00:57

abc123281 发表于 2022-12-28 23:19
哦，是个女生呀

劳驾给琢磨下看下我说的题义。。。。就是重新打开是有问题的。

chj6533 · 发表于 2022-12-29 00:58

abc123281 发表于 2022-12-28 23:19
哦，是个女生呀

老女生

:P:P:P:P:P

ykcbf1100 · 发表于 2022-12-29 08:43

简单改一下就行。

3190496160 · 发表于 2022-12-29 10:28

Set sht = wbk.ActiveSheet

3190496160 · 发表于 2022-12-29 10:47

Private Sub 分拆簿_簿c_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim dic As Object, wbk As Workbook, i As Integer
Dim rng As Range '定义一个单元格对象型变量
t = Timer
Set dic = CreateObject("Scripting.Dictionary")
   For i = 0 To 列表.ListCount - 1
   If 列表.Selected(i) Then
      dic(列表.List(i, 0)) = ""
   End If
Next i
If dic.Count = 0 Then MsgBox "请至少选择1项": Exit Sub
Set sh = ThisWorkbook.Worksheets("总表")
For Each k In dic.keys
sh.Copy ''拷贝总表为工作簿
Set wbk = ActiveWorkbook ''活动工作表赋值给变量wbk
With wbk.Worksheets(1)
      arr = .[a1].CurrentRegion ''
      For i = 2 To UBound(arr) '
         If VBA.Trim(arr(i, 1)) <> VBA.Trim(k) Then '如果a列不等于关键字
            If rng Is Nothing Then '如果rng为空
                  Set rng = .Rows(i) '整行复制给变量rng
            Else
                  Set rng = Union(rng, .Rows(i)) '用union形成一个聚合，相当于按住ctrl选择不连续区域
            End If
         End If
      Next i
      If Not rng Is Nothing Then rng.Delete '
      For Each shp In .Shapes
         shp.Delete
      Next shp '
End With
Set rng = Nothing '初始化变量rng
wbk.SaveAs ThisWorkbook.Path & "\分表\" & k & ".xlsx" '
wbk.Close '
Next k
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Unload UserForm2
MsgBox "耗时：" & Format(Timer - t, "0.000") & "秒"
End Sub

3190496160 · 发表于 2022-12-29 10:47

窗体工作簿操作学习.rar (312.69 KB, 下载次数: 8)

		自动登录	找回密码
密码			免费注册

[求助] 工作簿拆分出现的问题

评分

评分