vba excel macro Membuat makro untuk membandingkan nilai sel lalu menyisipkan baris di antara set

Saya percaya bahwa gambar akan menunjukkan semuanya.

Yang pertama adalah sumber di mana makro harus menyisipkan baris antara set dan menghitung jumlah set. Satu set dibangun oleh kolom "I" / Subject. Misalnya set "Store Z01"

Itu seharusnya hasilnya:

Saya telah berusaha keras tetapi tidak berhasil ... Bantuan apa pun akan sangat dihargai, bahkan dalam menyelesaikan sebagian dari seluruh tugas.

— mirusev
sumber

Harap dicatat bahwa Pengguna Super bukan layanan penulisan skrip / kode gratis. Jika Anda memberi tahu kami apa yang telah Anda coba sejauh ini (termasuk skrip / kode yang sudah Anda gunakan) dan di mana Anda macet maka kami dapat mencoba membantu dengan masalah tertentu. Anda juga harus membaca Bagaimana cara saya mengajukan pertanyaan yang bagus? .

— DavidPostill

Saya sadar akan hal itu, David. Hanya saya berada di loop tak berujung dan membutuhkan struktur segar / algo dan karena itu tidak menaruh kode apa pun di sini. Saya yakin itu bukan kode yang sempurna tetapi ini bekerja untuk saya :) Saya akan mempublikasikannya sebagai jawaban. Bagaimanapun, terima kasih!

— mirusev

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

— mirusev
sumber

Setiap optimasi diterima, itu hanya apa yang saya bisa .... Saya butuh waktu seharian untuk menulisnya

— mirusev