Excel宏——升级说明整理
2017-11-22 09:55
211 查看
Private Function SheetExists(sname) AsBoolean
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If
End Function
Sub Check()
Dim desDir As String
Dim filename As String
Dim rowMaxS As Integer
Dim rowMaxD As Integer
desDir = ThisWorkbook.Path & "\升级包制作\"
filename = Dir(desDir & "*.xls")
''检查sheet页名称是否规范
Workbooks(filename).Activate
If SheetExists("安装说明") And SheetExists("程序项列表") AndSheetExists("修改单列表") Then
Else
MsgBox "sheet页命名不规范请检查!"
Exit Sub
End If
''复制升级安装说明内容
rowMaxD = Workbooks(filename).Worksheets("安装说明").Range("B65536").End(xlUp).Row
rowMaxS = ThisWorkbook.Worksheets("安装说明").Range("B65536").End(xlUp).Row
Workbooks(filename).Activate
Sheets("安装说明").Select
Rows("5:100").Select
Selection.Delete Shift:=xlUp
ThisWorkbook.Activate
Sheets("安装说明").Select
Rows("5:" & rowMaxS).Select
Selection.Copy
Workbooks(filename).Activate
Sheets("安装说明").Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
''程序列表格式调整
'检查程序项个数
rowMaxD2 = Workbooks(filename).Worksheets("程序项列表").Range("A65536").End(xlUp).Row- 1
MsgBox "请检查程序项个数: " & rowMaxD2
'格式刷
ThisWorkbook.Activate
Sheets("程序项列表").Select
Rows("1:1").Select
Selection.Copy
Workbooks(filename).Activate
Sheets("程序项列表").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ThisWorkbook.Activate
Sheets("程序项列表").Select
Rows("2:2").Select
Selection.Copy
Workbooks(filename).Activate
Sheets("程序项列表").Select
Rows("2:"& rowMaxD2).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
''升级说明检查
'查找修改单备注、修改版本、修改单状态、测试发现问题及备注、附件
ColumnsArray = Array("修改单备注", "修改版本","修改单状态", "测试发现问题及备注", "附件")
Workbooks(filename).Activate
Sheets("修改单列表").Select
Rows("1:1").Select
For Each Column In ColumnsArray
R = Application.CountIf(Rows("1:1"), Column)
If R <> 0 Then
MsgBox "修改单列表存在不需要的列,请注意检查!" & Chr(13) & Column
Exit Sub
End If
Next
'''插入需求提出方编号
Workbooks(filename).Activate
Sheets("修改单列表").Select
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Select
ActiveCell.FormulaR1C1 = "需求提出方"
Range("K1").Select
ActiveCell.FormulaR1C1 = "需求提出方编号"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(C[-1],'[" & ThisWorkbook.Name & "]客户'!C4:C5,2,0)"
maxRow3 = Worksheets("修改单列表").Range("A65536").End(xlUp).Row
Selection.AutoFill Destination:=Range("K2:K" & maxRow3)
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_
:=False, Transpose:=False
'统计券商个数
Workbooks(filename).Activate
Sheets("修改单列表").Select
Range("H:H,J:J").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("sheet1").Select
Columns("A:B").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
maxRow1 =Worksheets("Sheet1").Range("A65536").End(xlUp).Row
ActiveSheet.Range("$A$1:$B$" & maxRow1).RemoveDuplicatesColumns:=1, Header:=xlYes
Sheets("Sheet2").Select
Cells.Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Sheet1").Select
Columns("B:B").Select
Selection.Copy
Sheets("Sheet2").Select
Columns("A:A").Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$" & maxRow1).RemoveDuplicatesColumns:=1, Header:=xlYes
maxRow2 =Worksheets("Sheet2").Range("A65536").End(xlU
4000
p).Row
Range("B2").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS(Sheet1!C,Sheet2!RC[-1])"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B" & maxRow2)
Range("B1").Select
ActiveCell.FormulaR1C1 = "数量"
Range("B2:B" & maxRow2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.AddKey:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A2:B86")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
maxRowf = maxRow2 + 1
Range("A" & maxRowf).Select
ActiveCell.FormulaR1C1 = "共计"
Sum = WorksheetFunction.Sum(Range(Cells(2, 2), Cells(65536,2).End(xlUp)))
Worksheets("sheet2").Cells((maxRow2 + 1), 2) = Sum
Range("D29").Select
Rows("2:2").Select
Selection.Copy
Rows(maxRow2 + 1 & ":" & maxRow2 + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If
End Function
Sub Check()
Dim desDir As String
Dim filename As String
Dim rowMaxS As Integer
Dim rowMaxD As Integer
desDir = ThisWorkbook.Path & "\升级包制作\"
filename = Dir(desDir & "*.xls")
''检查sheet页名称是否规范
Workbooks(filename).Activate
If SheetExists("安装说明") And SheetExists("程序项列表") AndSheetExists("修改单列表") Then
Else
MsgBox "sheet页命名不规范请检查!"
Exit Sub
End If
''复制升级安装说明内容
rowMaxD = Workbooks(filename).Worksheets("安装说明").Range("B65536").End(xlUp).Row
rowMaxS = ThisWorkbook.Worksheets("安装说明").Range("B65536").End(xlUp).Row
Workbooks(filename).Activate
Sheets("安装说明").Select
Rows("5:100").Select
Selection.Delete Shift:=xlUp
ThisWorkbook.Activate
Sheets("安装说明").Select
Rows("5:" & rowMaxS).Select
Selection.Copy
Workbooks(filename).Activate
Sheets("安装说明").Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
''程序列表格式调整
'检查程序项个数
rowMaxD2 = Workbooks(filename).Worksheets("程序项列表").Range("A65536").End(xlUp).Row- 1
MsgBox "请检查程序项个数: " & rowMaxD2
'格式刷
ThisWorkbook.Activate
Sheets("程序项列表").Select
Rows("1:1").Select
Selection.Copy
Workbooks(filename).Activate
Sheets("程序项列表").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ThisWorkbook.Activate
Sheets("程序项列表").Select
Rows("2:2").Select
Selection.Copy
Workbooks(filename).Activate
Sheets("程序项列表").Select
Rows("2:"& rowMaxD2).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
''升级说明检查
'查找修改单备注、修改版本、修改单状态、测试发现问题及备注、附件
ColumnsArray = Array("修改单备注", "修改版本","修改单状态", "测试发现问题及备注", "附件")
Workbooks(filename).Activate
Sheets("修改单列表").Select
Rows("1:1").Select
For Each Column In ColumnsArray
R = Application.CountIf(Rows("1:1"), Column)
If R <> 0 Then
MsgBox "修改单列表存在不需要的列,请注意检查!" & Chr(13) & Column
Exit Sub
End If
Next
'''插入需求提出方编号
Workbooks(filename).Activate
Sheets("修改单列表").Select
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Select
ActiveCell.FormulaR1C1 = "需求提出方"
Range("K1").Select
ActiveCell.FormulaR1C1 = "需求提出方编号"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(C[-1],'[" & ThisWorkbook.Name & "]客户'!C4:C5,2,0)"
maxRow3 = Worksheets("修改单列表").Range("A65536").End(xlUp).Row
Selection.AutoFill Destination:=Range("K2:K" & maxRow3)
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_
:=False, Transpose:=False
'统计券商个数
Workbooks(filename).Activate
Sheets("修改单列表").Select
Range("H:H,J:J").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("sheet1").Select
Columns("A:B").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
maxRow1 =Worksheets("Sheet1").Range("A65536").End(xlUp).Row
ActiveSheet.Range("$A$1:$B$" & maxRow1).RemoveDuplicatesColumns:=1, Header:=xlYes
Sheets("Sheet2").Select
Cells.Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Sheet1").Select
Columns("B:B").Select
Selection.Copy
Sheets("Sheet2").Select
Columns("A:A").Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$" & maxRow1).RemoveDuplicatesColumns:=1, Header:=xlYes
maxRow2 =Worksheets("Sheet2").Range("A65536").End(xlU
4000
p).Row
Range("B2").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS(Sheet1!C,Sheet2!RC[-1])"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B" & maxRow2)
Range("B1").Select
ActiveCell.FormulaR1C1 = "数量"
Range("B2:B" & maxRow2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks_
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.AddKey:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A2:B86")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
maxRowf = maxRow2 + 1
Range("A" & maxRowf).Select
ActiveCell.FormulaR1C1 = "共计"
Sum = WorksheetFunction.Sum(Range(Cells(2, 2), Cells(65536,2).End(xlUp)))
Worksheets("sheet2").Cells((maxRow2 + 1), 2) = Sum
Range("D29").Select
Rows("2:2").Select
Selection.Copy
Rows(maxRow2 + 1 & ":" & maxRow2 + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
相关文章推荐
- linux下定时执行任务的方法及crontab 用法说明(收集整理)
- SequoiaDB版本在线升级介绍说明
- 双向自由升级的详细说明
- JAVA_用_JCO连接_SAP,实现调用SAP_的_RFC_函数(整理)(附一篇看起来比较全面的说明)(JCO报错信息)
- Android Studio 3.0.1升级--出现的坑(多方整理出来的)
- Openssl源代码整理学习---含P7/P10/P12说明
- mysql引擎分析说明整理
- 系统升级修改说明:JDK1.3 升级到 JDK1.6
- 软件开发人员向系统分析师升级必须改变2个不起眼的习惯(补充说明)
- 关于DirectX高级动画书中使用的9.0bsdk的升级说明 cXParser类(dx9.0c sdk vs2003编译运行通过)
- 各种数据库连接说明【同学_彪哥整理】
- dataTables-使用详细说明整理
- dataTables-使用详细说明整理
- Informix数据表结构分析资料整理之字段类型说明和查询SQL语句
- win2000server及win2003服务器组策略恢复整理说明
- PHP重要安全升级说明 推荐升级php 5.2.17版本
- 开源任务管理平台TaskManagerV2.0介绍及升级说明
- Android中数据库升级说明
- TortoiseGit升级操作说明
- 【第三节】android增量升级之提供服务端代码,整理项目