Excel宏——升级说明整理

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(xlUp).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