oh iya, ada Sum-nya
moga-moga begini bisa dinamis
Dim rng As Range
Dim rng1 As Range
Dim rngTarget As Range
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
Set rngTarget = Range(Range("d2")).Offset(1). _
Resize(Range("a4").CurrentRegion.Rows.Count - 1)
Set rng1 = Range(Range("d2")).Offset(1)
'posisi sum pertama saja yang dipakai
Set rng = Range("A4").CurrentRegion.Resize(columnsize:=1). _
Find("SUM").Offset(0, Range(Range("d2")).Column - 1)
'biar dinamis, diganti dikit
rngTarget.FormulaArray = _
"=INDEX(Source!$B$1:$B$8,MATCH(" & _
rngTarget.Offset(0, -(rngTarget.Column - 1)).Address & _
",Source!$A$1:$A$8,0))"
ActiveSheet.Calculate
rngTarget.Copy
rngTarget.PasteSpecial xlPasteValues
'=SUM(F$5:F7)-2*SUMIF(A$5:A7,"SUM",F$5:F7)
rng.Formula = "=sum(" & rng1.Address(True, False) & ":" & _
rng.Offset(-1).Address(False, False) & ")-2*sumif(A$5:A" &
_
rng.Row - 1 & ",""SUM""," & rng1.Address(True, False) & _
":" & rng.Offset(-1).Address(False, False) & ")"
ActiveSheet.Calculate
rng1.CurrentRegion.AutoFilter 1, "SUM"
rng.Copy
rngTarget.SpecialCells(xlCellTypeVisible).PasteSpecial xlPasteFormulas
ActiveSheet.AutoFilterMode = False
ActiveSheet.Calculate
rngTarget.Copy
rngTarget.PasteSpecial xlPasteValues
Application.ScreenUpdating = True
Kelihatannya panjang, tapi semua hanya 1 kali kerja, kalau excelnya,
berkali-kali oleh array formula dan sum
Prinsip :
- simpan range target (per tanggal yang mau diisi nilai saja)
- simpan range pertama nilai
- simpan range sum pertama
- pasang array formula di target dan dikalkulasi
(siapa tahu tidak automatic -- hilangkan saja kalau pasti automatic)
- pasang formula sum di sum pertama saja (bukan array formula) dan kalkulasi
juga
- filter type by SUM
- copy formula sum ke cell sum lainnya (cell selain sum tidak di beri
formula) jadi hanya 2 baris cell sum yang ada formula sum-nya (biar enteng
si excel)
- off kan autofilter supaya bisa copy paste values seluruh range target
Kid.
On Mon, Feb 22, 2010 at 3:39 PM, siti Vi <[email protected]> wrote:
>
>
>
> karena
> (mungkin) mas Kid belum menujukan prosedur tsb untuk
> tabel result yg baru (yg sudah diberi sisipan dua bari SUM )
> ------------------------------
>
> ----- Original Message -----
> From: Khozhot
> To: [email protected]
> Sent: Monday, February 22, 2010 3:10 PM
> Subject: Re: [belajar-excel] Placed Result
> Di komputah q hasil SUM nya koq ellol yach!??!
> Wassalam.
> ...zhot thea
>
>
> *On Mon, 22 Feb 2010 14:20:42 +0700, Mr. Kid <[email protected]> wrote:
> *sudah selesai ya kasusnya
> kok panjang banget, kayanya pada asik..
> yang ini tanpa loop sendiri (biar excel yang nge-loop-in
>
> Application.ScreenUpdating = False
> Dim rngTarget As Range
> Set rngTarget = Range(Range("d2")).Offset(1). _
> Resize(Range("a4").CurrentRegion.Rows.Count - 1)
> rngTarget.FormulaArray = _
> "=INDEX(Source!$B$1:$B$8,MATCH(Result!$A$5:$A$11,Source!$A$1:$A$8,0))"
> rngTarget.Copy
> rngTarget.PasteSpecial xlPasteValues
> Application.CutCopyMode = False
> Application.ScreenUpdating = True
>
> Kid.
>
>
