根据关键字拆分工作表

chqf

UBound(bt)改成列标（c) 就可以了
.Range("a1").Resize(1,c ) = bt

chxw68

chqf 发表于 2014-6-28 11:11
.Range("a1").Resize(1, UBound(bt)) = bt
为什么只有A1单有数据元格（序号），其他都是空的？

ubound(bt,2)

chqf

再请教chxw68 老师：
1、我把代码复制到其他工作表后，运行时为什么提示“用户类型未定义？”
2、我把这段宏作为加载宏后，运行时提示“类workbook的saveas方法无效”？

chqf

再请教chxw68 老师：
1、我把代码复制到其他工作表后，运行时为什么提示“用户类型未定义？”
2、我把这段宏作为加载宏后，运行时提示“类workbook的saveas方法无效”？
(沉了，顶上去）

chxw68

1. Sub test()
   
2.   Dim reg As Object
   
3.   Dim r%, i%, l%
   
4.   Dim arr
   
5.   Dim d As Object
   
6.   Dim str As String
   
7.   Dim x As Integer
   
8.   Dim bt
   
9.   Set d = CreateObject("scripting.dictionary")
   
10.   Set reg = CreateObject("vbscript.regexp")
    
11.   
    
12.   Application.ScreenUpdating = False
    
13.   Application.DisplayAlerts = False
    
14.   Application.SheetsInNewWorkbook = 1
    
15.   With Worksheets("aa")
    
16.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
17.     bt = .Range("a1").Resize(1, c)
    
18.   End With
    
19.   With reg
    
20.     .Global = True
    
21.     .Pattern = "外税|鼓楼|闽侯|福清|保税|音西|融城|晋安|仓山|连江|台江|永泰|闽清"
    
22.   End With
    
23.   With Worksheets(1)
    
24.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
25.     l = Range("a1").End(xlToRight).Column
    
26.     arr = .Range("a2").Resize(r - 1, l)
    
27.   End With
    
28.   x = InputBox("请输入拆分关键字所在的列标：" & Chr(10) & Chr(10) & "例如在D列，则输入4", "友情提示：")
    
29.   For i = 1 To UBound(arr)
    
30.     If reg.test(arr(i, x)) Then
    
31.       Set mh = reg.Execute(arr(i, x))
    
32.       d(mh(0).Value) = d(mh(0).Value) & "+" & i
    
33.     End If
    
34.   Next
    
35.   'For Each ws In Worksheets
    
36.     'If ws.Name <> "Sheet1" Then
    
37.      ' ws.Delete
    
38.     'End If
    
39.   'Next
    
40.   For Each aa In d.Keys
    
41.     brr = Split(Mid(d(aa), 2), "+")
    
42.     ReDim crr(1 To UBound(brr) + 1, 1 To l)
    
43.     For i = 0 To UBound(brr)
    
44.       For j = 1 To l
    
45.         crr(i + 1, j) = arr(brr(i), j)
    
46.       Next
    
47.     Next
    
48.     Set wb = Workbooks.Add
    
49.     With wb
    
50.       With .Worksheets(1)
    
51.     ' With ActiveWorkbook
    
52.         .Range("a1").Resize(1, UBound(bt, 2)) = bt
    
53.         .Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
    
54.         '.Sheets(1).UsedRange.Offset(m).Clear
    
55.         '.Sheet(1).[a1].Resize(UBound(crr), UBound(crr, 2)) = crr
    
56.       End With
    
57.       .SaveAs Filename:=ThisWorkbook.Path & "" & aa & ".xls"
    
58.      ' .SaveAs ThisWorkbook.Path & "" & aa & ".xls"
    
59.       .Close
    
60.     End With
    
61.   Next
    
62. '    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
63. '    With ws
    
64. '      .Name = aa
    
65. '      .Range("a1:c1") = Array("序号", "名称", "管征单位")
    
66. '      .Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
    
67. '    End With
    
68. End Sub
    

复制代码

chxw68

第一个问题解决了，第二个问题我就不知其解了。

chqf

chxw68 老师：
  是这样的，我想把这个宏作为一个加载宏，就是说制作一个自定义按钮，如果要拆分其他工作表时，点击该按钮就可以直接运行宏，然后就提示第二个问题了。

chqf

我也是根据网上说的方法，把宏另存为.xla ,再加载，然后定义一个按钮。不知是不是我的方法不对？会不会该宏的文件位置和我要拆分的工作表位置不同引起的？应该怎么解决？

chqf

顶。能否麻烦 chxw68 老师再帮帮忙？

chqf

不好意思。经检查，发现 .Pattern = "外税|鼓楼|闽侯|福清|保税|音西|融城|晋安|仓山|连江|台江|永泰|闽清|"多加了“|”导致运行时提示“类workbook的saveas方法无效”。