Re: ]] XL-mania [[ Mengurai dan mengurutkan transaksi berulang

 

penyelesaian dari Oom Kid  was mantrabs surantab !!

tapi misalnya ingin tinggal pencet terombol; inilah makrohnya

(sambil tetap membuatkan TABLE NORMAL dulu, supaya bisa digunakan untuk keferluan lain)

Sub Abnormal_To_Normal()

   ' siti Vi / 20 Dec 2010

   ' Tabel kok ABNORMAL.., Ya di-NORMAL-kan dulu (dwong)!

   ' ---------------------------------------------------

   Dim AbNorm As Range, NormTb As Range

   Dim i As Long, j As Long, r As Long

   Dim Bulan, Reken, Nomin

   

   Set AbNorm = Sheets("Solusi").Cells(1).CurrentRegion

   Set NormTb = AbNorm.Offset(0, AbNorm.Columns.Count + 3)

   Application.Calculation = xlCalculationManual

   Application.ScreenUpdating = False

   

   AbNorm(1).Resize(1, AbNorm.Columns.Count).Copy

   NormTb(1).PasteSpecial xlPasteValues

   Application.CutCopyMode = False

   

   r = 1

   For i = 2 To AbNorm.Rows.Count

      Reken = Split(Trim(AbNorm(i, 3)), " ")

      Nomin = Split(Trim(AbNorm(i, 4)), " ")

      For j = 0 To UBound(Reken)

         r = r + 1

         NormTb(r, 1) = r - 1

         NormTb(r, 2) = AbNorm(i, 2)

         NormTb(r, 3) = Reken(j)

         NormTb(r, 4) = Val(Nomin(j))

      Next j

   Next i

   

   NormTb.CurrentRegion.EntireColumn.AutoFit

   NormTb.CurrentRegion.Name = "NormalTabel"

   Call NormalToReport(NormTb.CurrentRegion)

   

   Application.Calculation = xlCalculationAutomatic

   Application.ScreenUpdating = True

End Sub

Private Sub NormalToReport(NormTb As Range)

   ' setelah kita punya tabel NORMAL...

   ' barulah kita BISA & GAMPANG membuat REPORT...

   ' siti vi / bluewater, 20 Dec 2010

   '---------------------------------------------

   Dim Report As Range

   Dim AkJum() As Double, Bulans, DblBln, Rekens

   Dim Jml As Double, Rek As String

   Dim b As Integer, k As Long, n As Long, r As Long

   Dim nRows As Long, MaxR As Long

   

   Set NormTb = Range("NormalTabel")

   Set Report = NormTb.Offset(0, NormTb.Columns.Count + 3)

   nRows = NormTb.Rows.Count - 1

   Set NormTb = NormTb.Offset(1, 0).Resize(nRows, 1)

   Bulans = UniqList(NormTb.Offset(0, 1).Resize(nRows, 1))

   Rekens = UniqList(NormTb.Offset(0, 2).Resize(nRows, 1))

   Rekens = SortArray(Rekens)

   '--inga.. inga.. (thuing...!!)

   '  fungsi UniqList selalu menghasilkan array

   '  yang LBound (index pertamanya) = 0, bukan 1

   ReDim AkJum(LBound(Bulans) To UBound(Bulans))

      

   Report(1) = "Rec#"

   For b = LBound(Bulans) To UBound(Bulans) * 2 Step 2

      Report(1, b + 2) = Bulans(b / 2)

      Report(2, b + 2) = "Rekening"

      Report(2, b + 3) = "Jml Dana"

   Next

   

   '-- loop bertingkat 3, mo digunakan menjumlah dgn 2 syarat --

   '   & juga mernuliskan ke range 2 dimensi

   For b = LBound(Bulans) To UBound(Bulans)

      r = 2

      For k = LBound(Rekens) To UBound(Rekens)

         For n = 1 To nRows

            If NormTb(n, 2) = Bulans(b) And NormTb(n, 3) = Rekens(k) Then

               Jml = Jml + NormTb(n, 4)

               Rek = Rekens(k)

            End If

         Next n

         If Jml > 0 Then

            r = r + 1

            If MaxR <= r Then MaxR = r

            Report(r, 1) = r - 2

            Report(r, b * 2 + 2) = Rek

            Report(r, b * 2 + 3) = Jml

            AkJum(b) = AkJum(b) + Jml

            Jml = 0

         End If

      Next k

   Next b

   

   For b = 0 To UBound(Bulans)

      Report(MaxR + 2, b * 2 + 2) = "Jumlah"

      Report(MaxR + 2, b * 2 + 3) = AkJum(b)

   Next b

   Report.CurrentRegion.EntireColumn.AutoFit

End Sub

'---------yg diinginkan seorang tukang hanyalah ingin mendengar apakah alat buatannya bisa bekerja sgn baek -----------------

2010/12/19 andri apriyadi <andreemobile@yahoo.co.id>

Dear Pakar Excel, Mohon bantuannya untuk mengurai data transaksi yang saya terima ini sesuai dengan rekening2nya. Saya kesulitan karena adanya transaksi berulang baik dalam bulan yang sama maupun dengan rekening yang sama. Sebelumnya, terima kasih atas bantuannya. Regard Andree

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (3)

Recent Activity:

• New Members 99

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| sOrRy dOrRy j3K... m0m0dS LaGi HeC-tiC... waQaQaQa...             |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message,  melecehkan,  tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan  winzip  jika  perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke  |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau...  |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]  |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___