Excel Vba中的动态逻辑

Question

我有一本excel工作簿，里面有30个工作表。每一张纸都是这样的

​

​

现在，我想在"I“列之后插入一个列(新列将是J)，并且值应该如下所示

对于息票2.000(4-7行)，新列J中的值应该为=i4-i5(对于所有J4、5、6、7)，这应该对每个优惠券重复。我试着录制宏，但没有帮助。请提供me示例逻辑来动态处理此问题。提前谢谢你。

Answer 1

从你的描述，听起来这就是你要找的东西。如果情况并非如此，请告诉我。

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