ini macro saya copikan di excel yang laen gak mau,saya kasih warna merah
peruntah yg gak mau jalan..mohon dibantu
> 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--- 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 > > > > > > >
