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 <[email protected]> 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
>
>
>
re-solusinya apa.xlsb
Description: Binary data
