kalo gini gimana,
Sub Updating_Click()
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(4, Columns.Count).End(xlToLeft).Column
For i = 2 To LC
If Cells(4, i) = Range("B2") Then
Range(Cells(5, i), Cells(LR, i)).ClearContents
For n = 5 To LR
If Cells(n, 1) <> "SUM" Then
v = "=VLOOKUP(A" & n & ",Source!$A$2:$B$10,2,0)"
Cells(n, i) = Evaluate(v)
j = j + Cells(n, i)
ElseIf Cells(n, i) = "" Then
Cells(n, i) = j
j = 0
End If
Next n
End If
Next i
End Sub
selamat belajar.........
>semoga bermanfaat
________________________________
From: Khozhot <[email protected]>
To: [email protected]
Sent: Sat, February 20, 2010 3:38:51 PM
Subject: Re: [belajar-excel] Placed Result
Alhamdulillah,......
Siii...p dach. Ini yang kumaoooo....
Thanks yach.
q pelajari lagi ach......
--
Wassalam.
...zhot thea
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
On Sat, 20 Feb 2010 11:12:39 +0700, siti Vi <[email protected]> wrote:
>
>
>>
>
>>
>
>>
>
>1
>MAAF.. ada sedikit salah tulis
>sedikit dimakronya; seharusnya seperti ni
>
>Sub
>Updating4_Click()
> Dim dSourc As Range, dWrite As
>Range
> Dim Criter As Range, DateBr As Range
> Dim c
>As Integer, r As Long, i As Long
> Dim Akum As
>Double
>
> Set
>dSourc = Sheets("Source").Range("A2").CurrentRegion.Offset(1, 0)
>
>Set dSourc = dSourc.Resize(dSourc.Rows.Count - 1, 1)
> Set dWrite
>= Sheets("Result").Range("A5")
> Set DateBr = Range(dWrite(0, 1),
>dWrite(0, 1).End(xlToRight))
> Set Criter =
>Sheets("result").Range("B2")
>
> r = 1: Akum =
>0
> With WorksheetFunction
> c =
>.Match(Criter, DateBr, 0)
>
>Application.Calculation = xlCalculationManual
> Do
>While Not Len(dWrite(r, 1)) =
>0
> If .CountIf(dSourc,
>dWrite(r, 1)) > 0
>Then
> i =
>.Match(dWrite(r, 1), dSourc,
>0)
>
>dWrite(r, c) = dSourc(i,
>2)
> Akum =
>Akum + dSourc(i,
>2)
>
>ElseIf dWrite(r, 1) = "SUM:" >Then
>
>dWrite(r, c) =
>Akum
> Akum
>= 0
> End
>If
> r = r +
>1
>
>Loop
> Application.Calculation =
>xlCalculationAutomatic
> End With
>End Sub
>
>di dalam
>tabel RESULT kata "SUM" saya bedakan menjadi "SUM:"
>agar tidak dianggap data yg
>ada di tabel SOURCE
>(karena di sana ada juga
>data text "SUM" )
>
>workbook yg siti kirim
>sebelum ini (ctv_Placed_Result(2).xls)
>mohon dideleted
>saja
>
>
>2
>saran mengenai TOMBOL:
>saya cabut kembali
>
>(tidak jadi memberi
>saran)
>karena ternyata
>tombol-tombol itu untuk menjalankan contoh² makro
>dari berbagai
>member..
>sorrriii
>
>
>
>
________________________________
>----- Original Message -----
>>From: siti Vi
>>To: [email protected]
>>Sent: Saturday, February 20, 2010 10:30
>> AM
>>Subject: Re: [belajar-excel] Placed
>> Result
>>
>>prosedur dari siti yg kemarin dikirim dimodifikasi sedikit
>> menjadi seperti ini
>>
>>Sub
>> Updating4_Click()
>> Dim dSourc As Range, dWrite As
>> Range
>> Dim Criter As Range, DateBr As Range
>> Dim
>> c As Integer, r As Long, i As Long
>> Dim Akum As Variant
>>
>> Set dSourc =
>> Sheets("Source").Range("A2").CurrentRegion.Offset(1, 0)
>> Set
>> dSourc = dSourc.Resize(dSourc.Rows.Count - 1, 1)
>> Set dWrite =
>> Sheets("Result").Range("A5")
>> Set DateBr = Range(dWrite(0, 1),
>> dWrite(0, 1).End(xlToRight))
>> Set Criter =
>> Sheets("result").Range("B2")
>> r = 1
>> With
>> WorksheetFunction
>> c = .Match(Criter, DateBr,
>> 0)
>> Application.Calculation =
>> xlCalculationManual
>> Do While Not
>> Len(dWrite(r, 1)) = 0
>> If
>> .CountIf(dSourc, dWrite(r, 1)) > 0
>> Then
>> i =
>> .Match(dWrite(r, 1), dSourc,
>> 0)
>>
>> dWrite(r, c) = dSourc(i,
>> 2)
>> Akum = Akum + dWrite(r, c)
>> '<<salah
>>
>> ElseIf dWrite(r, 1) = "SUM"
>> Then
>>
>> dWrite(r, c) =
>> Akum
>>
>> Akum = 0
>> End
>> If
>> r = r +
>> 1
>> Loop
>>
>> Application.Calculation = xlCalculationAutomatic
>> End
>> With
>>End Sub
>>
>>
>>rgds,
>>siti
