EXCEL常用工具7.3正式版（功能强大并带使用说明）

quning5460

果真很好很强大

aoe1981

第一个文字内容的加密、解密太神奇了，这只能说明，很多时候乱码不乱，只是没有解密工具，没有发现其中蕴藏的规律而已……

liuyi2872

有了这个工具，一下子赶脚自己变强大了！

fuckeh

挺不错的，谢谢楼主分享

moioscar

果真很好很强大。

393983882

楼主好精华的帖子，学习了

393983882

楼主这个2007版本的可以用吗？

chqf

彭老师：您的常用工具7.3版确实很好用，为我的实际工作解决了许多问题，提高了工作效率。但我有个小的需求，想实现通过列中部分关键字比如：外税、鼓楼、闽侯、福清等（关键字位置不固定），进行单元格的拆分。我也是通过在论坛发帖，chxw68老师帮我写了一段代码，具体代码如下：Sub auto_open()
Set myMenu = Application.CommandBars("worksheet menu bar")
Set Button = myMenu.Controls.Add(Type:=msoControlButton)
Button.Caption = "按管征单位拆分工作表"            '按钮上的文字，填写你需要的
Button.Style = msoButtonIconAndCaption
Button.FaceId = FaceId                  '按钮图标,数字比如8，系统存在的
Button.OnAction = "test"       '按钮执行的宏名，填写你自己编写的宏的宏名

End Sub
Sub test()
  Dim reg As Object
  Dim r%, i%, l%
  Dim arr
  Dim d As Object
  Dim str As String
  Dim x,y As Integer
  Dim bt
  Set d = CreateObject("scripting.dictionary")
  Set reg = CreateObject("vbscript.regexp")
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.SheetsInNewWorkbook = 1
  With Worksheets(1)
    c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    bt = .Range("a1").Resize(1, c)
  End With
  With reg
    .Global = True
    .Pattern = "外税|鼓楼|闽侯|福清|保税|音西|融城|晋安|仓山|连江|台江|永泰|闽清"
  End With
  With Worksheets(1)
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    l = Range("a1").End(xlToRight).Column
    arr = .Range("a2").Resize(r - 1, l)
  End With
  x = InputBox("请输入拆分关键字所在的列标：" & Chr(10) & Chr(10) & "例如在D列，则输入4", "友情提示：")
  y= InputBox("请输入表头占用的行数：" , "友情提示：")

For i = 1 To UBound(arr)
    If reg.test(arr(i, x)) Then
      Set mh = reg.Execute(arr(i, x))
      d(mh(0).Value) = d(mh(0).Value) & "+" & i
    End If
  Next
  'For Each ws In Worksheets
    'If ws.Name <> "Sheet1" Then
     ' ws.Delete
    'End If
  'Next
  For Each aa In d.Keys
    brr = Split(Mid(d(aa), 2), "+")
    ReDim crr(1 To UBound(brr) + 1, 1 To l)
    For i = 0 To UBound(brr)
      For j = 1 To l
        crr(i + 1, j) = arr(brr(i), j)
      Next
    Next
    Set wb = Workbooks.Add
    With wb
      With .Worksheets(1)
    ' With ActiveWorkbook
        .Range("a1").Resize(y, UBound(bt, 2)) = bt
        .Range("a"&y+1).Resize(UBound(crr), UBound(crr, 2)) = crr
        '.Sheets(1).UsedRange.Offset(m).Clear
        '.Sheet(1).[a1].Resize(UBound(crr), UBound(crr, 2)) = crr
      End With
      .SaveAs Filename:=ThisWorkbook.Path & "\" & aa & ".xls"
     ' .SaveAs ThisWorkbook.Path & "\" & aa & ".xls"
      .Close
    End With
  Next
'    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
'    With ws
'      .Name = aa
'      .Range("a1:c1") = Array("序号", "名称", "管征单位")
'      .Range("a2").Resize(UBound(crr), UBound(crr, 2)) = crr
'    End With
End Sub

能否把该段代码整合到您的程序中，方便使用。
另外，如果想在新拆分的工作表中保留原有的格式，又该如何修改完善代码？拜托老师抽空看看！

chqf

呼叫彭老师。自己顶。

ychaoqun

在那里下呢