20170708xlVBA添加新产品修改公式

Sub ControlInsertProduct()
    Dim Wb As Workbook
    Dim OneSht As Worksheet
    Dim Arr As Variant
    Dim i As Long
    Arr = Array("农家香菜籽油（20L）", "万家炊大豆油（20L）", "万家炊原香菜籽油（20L）", "压榨菜籽油（20L）")
    Set Wb = Application.ThisWorkbook
    For Each OneSht In Wb.Worksheets
        If IsNumeric(OneSht.Name) Or OneSht.Name = "月销量" Then
            For i = LBound(Arr) To UBound(Arr)
                InsertNewProduct OneSht, Arr(i)
            Next i
        End If
    Next OneSht
    Set Wb = Nothing
    Set OneSht = Nothing
End Sub

Sub InsertNewProduct(ByVal Sht As Worksheet, ByVal ProductName As String)
    Dim InsertCol&, EndCol&, EndRow&   '插入列和结束列
    Dim CopyStart, CopyEnd    '复制的起始列
    Dim OrgRng As Range
    With Sht
        EndCol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
        EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
            InsertCol = EndCol - 2
            CopyStart = EndCol - 5
            CopyEnd = EndCol - 3
            Set OrgRng = .Range(.Cells(2, CopyStart), .Cells(EndRow, CopyEnd))
            OrgRng.Copy
            .Cells(2, InsertCol).Insert xlShiftToRight, xlFormatFromLeftOrAbove
            .Cells(2, InsertCol).Value = ProductName


        '修改公式
        EndCol = EndCol + 3
   
        For i = 4 To EndRow - 2
            If Not .Cells(i, EndCol - 2).Formula Like "*SUM*" Then
                Formula = "="
                For j = 4 To EndCol - 3 Step 3
                    Formula = Formula & "+" & .Cells(i, j).Address
                Next j
                Formula = Replace(Formula, "+", "", , 1)
                .Cells(i, EndCol - 2).Value = Formula
            End If

            If Not .Cells(i, EndCol - 1).Formula Like "*SUM*" Then
                Formula = "="
                For j = 5 To EndCol - 3 Step 3
                    Formula = Formula & "+" & .Cells(i, j).Address
                Next j
                Formula = Replace(Formula, "+", "", , 1)
                .Cells(i, EndCol - 1).Value = Formula
            End If

            If Not .Cells(i, EndCol - 0).Formula Like "*SUM*" Then
                Formula = "="
                For j = 6 To EndCol - 3 Step 3
                    Formula = Formula & "+" & .Cells(i, j).Address
                Next j
                Formula = Replace(Formula, "+", "", , 1)
                .Cells(i, EndCol - 0).Value = Formula
            End If


        Next i
    End With

    Set OrgRng = Nothing
End Sub
  

　　

转载于:https://www.cnblogs.com/nextseven/p/7138745.html