鲁班软件官网  |   鲁班课堂  |   BIM视频精选  |   BIM直播课程  |   BIM文库  |   BIM软件下载  |   BIM论坛
鲁班商城 
发新话题
打印

删除新系统计算书的表头

删除新系统计算书的表头

计算书导出EXCEL  选新系统计算书A列调用宏命令’‘删表头’‘,就可**除新系统计算书的表头。

[ 本帖最后由 KK74 于 2016-5-1 14:12 编辑 ]

TOP

Sub 删表头()
Dim temp1 As String, temp2 As String, temp3 As String, temp4 As String, temp5 As String
Dim i As Long
Dim c  As Range
Application.ScreenUpdating = False '关闭屏幕刷新
For Each c In Selection
If c.MergeCells Then
c.Select
c.UnMerge
Selection.Value = c.Value
End If
Next c
On Error Resume Next
temp1 = "系统计算书"
temp2 = "工程名称:"
temp3 = ""
temp4 = "鲁班*"
temp5 = "序号"
For i = 1 To [A65536].End(3).Row
Cells.Find(temp4).EntireRow.Delete
Range("A:A").Find(temp1).EntireRow.Delete
Range("A:A").Find(temp2).EntireRow.Delete
Range("A:A").Find(temp3).EntireRow.Delete
Range("A:A").Find(temp4).EntireRow.Delete
Range("A:A").Find(temp5).EntireRow.Delete
Next
    Range("B1").Select
    Cells.Replace What:="风管材质:普通薄钢板", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      Cells.Replace What:="截面形状:矩形", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False
         Cells.Replace What:="接口形式:法兰连接(咬口)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False
          Cells.Replace What:="保温材料:玻璃棉", Replacement:="", LookAt:=xlPart, _
           SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False
        Cells.Replace What:="保温厚度δ(mm):50", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False
              Cells.Replace What:="管道规格:*", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False
         Cells.Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   r = Range("J65536").End(xlUp).Row
       Range("A1:A" & r).Select
      Selection.RowHeight = 20
       Application.ScreenUpdating = True '打开屏幕刷新
End Sub
在新建一个excel表,按ALT+F11,弹出VBA窗口选插入菜单下的插入模块,复制上面的代码,保存名称自己取。导出的系统计算书中按ALT+F8,弹出宏窗口选“删表头”按执行就可以册除所有页的表头,就可以方便进行数据处理。

[ 本帖最后由 KK74 于 2016-5-1 14:21 编辑 ]
本帖最近评分记录

TOP

发新话题