开发者

Dynamic Logic in Excel Vba

开发者 https://www.devze.com 2023-03-28 21:41 出处:网络
I have a excel workbook which has 30 worksheets in it. Each sheet looks something like this Now i want to insert a column after \"I\" column (开发者_JS百科the new column will be J)and the values sh

I have a excel workbook which has 30 worksheets in it. Each sheet looks something like this

Dynamic Logic in Excel Vba

Now i want to insert a column after "I" column (开发者_JS百科the new column will be J)and the values should be some thing like this

for coupon 2.000(4-7 rows) the values in the new column J should be = i4-i5(For all J4,5,6,7) This should be repeated for each coupon. I tried recording the macro but did not help. Please provide me sample logic to handle this dynamically. Thank you in advance.


From your description, it sounded like this is what you are looking for. Please let me know if that is not the case.

Sub AddNewColumn()
    Dim sColumnToIns, sCouponField, sCouponGroup, _
        sFormula, sCell1, sCell2, sMarketValueField, sColumnToInsHeader, sTopCellOfData
    Dim rData As Range
    Dim rRng As Range
    Dim rCell As Range
    Dim oSh As Worksheet

    'Make sure you change the sheet to reflect
    'the object name of your sheet.
    Set oSh = Sheet2
    sColumnToIns = "J"
    sColumnToInsHeader = "New Column"
    sCouponField = "B"
    sMarketValueField = "I"
    sTopCellOfData = "A4"


    'Insert a new column
    Sheet1.Range(sColumnToIns & ":" & sColumnToIns).Insert xlShiftToRight

    'Get lowest cell in used range
    Set rRng = oSh.UsedRange.Cells(oSh.UsedRange.Rows.Count, oSh.UsedRange.Columns.Count)
    Set rData = oSh.Range(sTopCellOfData, rRng)

    'Set the header text
    rData.Range(sColumnToIns & "1").Offset(-1).Value = sColumnToInsHeader

    'Go through the entire data set. Whenever the value in the 'Coupon'
    'column changes, put a formula the subtracts the top market value
    'from the next market value down.
    sCouponGroup = ""
    For Each rCell In rData.Columns(sCouponField).Cells
        If sCouponGroup <> rCell.Value Then
            sCouponGroup = rCell.Value
            sCell1 = rCell.EntireRow.Columns(sMarketValueField).Address
            sCell2 = rCell.EntireRow.Columns(sMarketValueField).Offset(1).Address
            sFormula = "=" & sCell1 & "-" & sCell2
        End If

        rCell.EntireRow.Columns(sColumnToIns).Formula = sFormula
    Next

End Sub
0

精彩评论

暂无评论...
验证码 换一张
取 消