☰

vba excel 宏创建一个宏来比较单元格值，然后在集合之间插入一行

tag-icon • tag-icon microsoft-excel vba macros comparison cells
vba excel 宏创建一个宏来比较单元格值，然后在集合之间插入一行

我相信照片会说明一切。

第一个是源，宏应在其中在集合之间插入一行并计算集合的总和。一个集合由列“I”/主题构建。例如集合“Store Z01”

来源

结果应该是这样的：

结果

我已经尽力了，但没有成功......任何帮助都将不胜感激，即使只是解决整个任务的一部分。

答案1

Sub FindSets_and_Sum()
'
    ScreenUpdating = False
    Columns("A:j").Sort key1:=Range("i:i"), order1:=xlAscending, Header:=xlYes
    ActiveSheet.Range("i2").Select
    FirstItem = ActiveCell.Value
    SecondItem = ActiveCell.Offset(1, 0).Value
    Offsetcount = 1
    Rowoffset = 0
    myNum = 100
    'myNum = (Range("A" & Rows.Count).End(xlUp).Row)
    Do While myNum > 0
        If FirstItem = SecondItem Then
            Offsetcount = Offsetcount + 1
            Rowoffset = Rowoffset + 1
            SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
        Else
            Set myActiveCell = ActiveCell
            Set MyActiveCell_01 = ActiveCell
            MyActiveRow_01 = ActiveCell.Row
            MyActiveColumn_01 = ActiveCell.Column
            Set myActiveWorksheet = ActiveSheet
            Set myActiveWorkbook = ActiveWorkbook
            Dim Report As Worksheet 'Set up your new worksheet variable.
            Set Report = Excel.ActiveSheet 'Assign the active sheet to the variable.
            mySum = WorksheetFunction.Sum(Range("j" & MyActiveRow_01 & ":j" & MyActiveRow_01 + Rowoffset))
            Report.Cells(MyActiveRow_01, MyActiveColumn_01 + 2).Value = mySum 'Add the function.
            mySum = 0
            ActiveCell.Offset(Offsetcount, 0).Rows("1:1").EntireRow.Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            myActiveWorkbook.Activate
            myActiveWorksheet.Activate
            myActiveCell.Activate
            Set MyActiveCell02 = ActiveCell
            Set MyActiveCell_02 = ActiveCell
            MyActiveRow_02 = ActiveCell.Row
            MyActiveColumn_02 = ActiveCell.Column

            ActiveCell.Offset(Offsetcount + 1, 0).Select
            If ActiveCell.Value = "" Then
                myNum = 0
            End If

            FirstItem = ActiveCell.Value
            SecondItem = ActiveCell.Offset(1, 0).Value
            Offsetcount = 1
            myNum = myNum - 1
            Rowoffset = 0
        End If
    Loop
    ScreenUpdating = True
End Sub

相关内容