subtotal pada makro data langsung

Saya telah membuat tabel data melalui pelaporan Sharperlight yang menghasilkan hasilnya ke dalam excel seperti yang ditunjukkan di bawah ini:-

masukkan deskripsi gambar di sini

Yang ingin saya lakukan adalah mengembangkan makro yang akan menjumlahkan semua kategori untuk data. Tidak ada ukuran panjang tabel yang ditentukan selain selalu berupa kolom G – J.

Dengan cara ini harapan saya adalah ketika pengguna me-refresh tabel menggunakan menu di samping mereka kemudian dapat menjalankan makro untuk mendapatkan total satu baris dengan cepat untuk setiap kategori.

Adakah yang bisa membantu dengan ini???


excel vba excel-2010
person user1086159    schedule 13.06.2013    source sumber
comment
bagaimana cara pengguna mengubah nilai dalam menu? mengetik?   -  person    schedule 13.06.2013
comment
mereka mengklik dua kali untuk membuka sub menu untuk tahun, bulan dan jenis posting. Yang dilakukan hanyalah menyegarkan tabel dan memungkinkan mereka memfilter secara spesifik seperti tahun.   -  person user1086159    schedule 13.06.2013
comment
acara apa yang menjalankan penyegaran? karena Anda cukup menambahkan sub lain setelah penyegaran untuk menghitung total   -  person    schedule 13.06.2013
comment
ketika tabel disegarkan, ia mengambil dari kueri SQL. Tanpa harus menyalin dan menempelkan nilai saja, saya tidak dapat melihat cara untuk menjumlahkan grup?   -  person user1086159    schedule 13.06.2013
comment
di baris mana data dimulai   -  person    schedule 13.06.2013
comment
headernya adalah baris 4, baris data 5 selalu kolom G - J   -  person user1086159    schedule 13.06.2013
comment
tabel Pivot (dan kemungkinan filter yang ditawarkannya secara default) bukan suatu pilihan?   -  person MikeD    schedule 13.06.2013

Jawaban (1)


arrow_upward
1
arrow_downward

Klik kanan pada tab sheet1 > Lihat Kode
sheet1 lihat kode
tempelkan kode ini

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
        If Target.Row = 4 Or Target.Row = 5 Or Target.Row = 6 Then Totals
    End If
End Sub

lalu tambahkan module klik kanan Sheet1 di Project Explorer di VBE window dan Insert > Module
lalu tempel kode ini

Sub Totals()

    Range("C10:D" & Range("C10:C" & Rows.Count).End(xlDown).Row).ClearContents
    Dim startAtRow As Long
    startAtRow = 10 ' Set starting row
    Dim lr As Long, i As Long, j As Long
    lr = Range("J" & Rows.Count).End(xlUp).Row
    ReDim arr(lr - 4) As String
    For i = 5 To lr
        arr(i - 5) = Range("J" & i).Value
    Next i
    Dim arr2() As String
    arr2 = arr
    RemoveDuplicate arr
    For i = LBound(arr) To UBound(arr) - 1
        Range("C" & (i + startAtRow)).Value = arr(i)
        For j = LBound(arr2) To UBound(arr2) - 1
            If arr(i) = arr2(j) Then
                Range("D" & (i + startAtRow)).Value = Range("D" & i + startAtRow).Value + Range("I" & (j + 5)).Value
            End If
        Next j
    Next i

End Sub

Private Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
    If (Not StringArray) = True Then Exit Sub
    lowBound = LBound(StringArray): UpBound = UBound(StringArray)
    ReDim tempArray(lowBound To UpBound)
    cur = lowBound: tempArray(cur) = StringArray(lowBound)
    For A = lowBound + 1 To UpBound
        For B = lowBound To cur
            If LenB(tempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B: tempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray
End Sub

Sekarang setiap kali pengguna mengubah nilai D4,D5,D6, hasil Anda akan diperbarui. Kategori akan ditampilkan mulai dari C10 ke bawah, dan totalnya di D10 ke bawah. Tampilannya seperti ini (versi contoh)
results

person Community    schedule 13.06.2013
comment
Itu luar biasa!! Terimakasih banyak. jika saya ingin subtotalnya muncul di lembar terpisah, bukan C10 dan D10, apakah cukup mudah untuk mengubahnya? - person user1086159; 13.06.2013
comment
Ya. awali Range("D" ... dengan Sheets("sheet name").Range("D" ... + sheets(1).Range("I" ... dan jika Anda ingin mengubah baris awal, lihat komentar di kode yang bertuliskan Set starting row dan ubah nilai baris dari 10 menjadi yang Anda inginkan. Juga jika Anda ingin mengubah kolom maka gunakan Sheets("sheet name").Cells(startAtRow, [column number here])... atau ganti huruf C dan D dengan misalnya A dan B - person ; 13.06.2013