wah terim kasih banyak neh master aji,dikasih pencerahan dengan macro,cb saya pelajarin dulu..mohon bimbinganya master.
--- In [email protected], aji mumpung <pupung1986@...> wrote: > > ikutan.. > mungkin bukan solusi optimal, karena pake kolom bantu yang dijalankan > dengan macro hehehe > terakhir.. kolom bantunya dihapus lagi jadi di detail RAB bersih dari kolom > bantu > > cara ini terinspirasi dari solusi Master Kid yang sebelumnya menawarkan > solusi dengan formula > > codenya ditulis dalam sebuah modul dan dijalankan dengan menekan sebuah > tombol > > Option Explicit > ' ====================================== > ' coded by: Aji Mumpung > ' terinspirasi dari formula master Kid > ' kaki gunung merbabu, 17 Oktober 2012 > ' sambil angon kambing & nyari rumput > ' ====================================== > Sub AnalisaRAB() > Dim hdIdAhsDtl, hdIdAhsRab As Range > Dim idxRowDtl, idxRowAHS As Long > Dim r, RecNo, Htg As Long > > Application.ScreenUpdating = False > Set hdIdAhsDtl = Sheet2.Range("b9") > If Sheet2.Range("b9").Value = "" Then > MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan" > Exit Sub > End If > Set hdIdAhsRab = Sheet1.Range("c6") > idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row > idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row > For r = 9 To idxRowDtl > Sheet2.Select > If Cells(r, 2) = "" Then > Cells(r, 11).Value = Cells(r - 1, 11).Value > Else > Cells(r, 11).Value = Cells(r - 1, 11).Value + 1 > End If > If Cells(r - 1, 11).Value = Cells(r, 11).Value Then > Cells(r, 12).Value = Cells(r - 1, 12).Value > Else > Cells(r, 12).Value = > Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5), > Sheet1.Cells(idxRowAHS, 5)), _ > Application.WorksheetFunction.Match(Sheet2.Cells(r, 2), > Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0)) > End If > If Cells(r, 12).Value <> 0 Then > Range(Cells(r, 2), Cells(r, 10)).Copy > Sheet3.Select > Range("c8").Select > If ActiveCell.Offset(1, 0) = "" Then > ActiveCell.Offset(1, -1).Select > Else > ActiveCell.End(xlDown).Offset(1, -1).Select > End If > ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats) > Application.CutCopyMode = False > End If > Next r > Sheet2.Select > Range("k:l").Delete > Application.ScreenUpdating = True > End Sub > > > wassalam, > > -aji mumpung- > #lagi angon sambil cari rumput# > > Pada 16 Oktober 2012 19:11, luthfi amin <luthfie_27@...> menulis: > > > ** > > > > > > waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi > > anggota.. > > > > dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak > > master ada sekitar 650 analisa.. > > > > ada tidak formula atau macro yang lebih efektif?? > > > > trimakasih > > > > > > >
