Re: [belajar-excel] Placed Result

Sat, 20 Feb 2010 00:39:15 -0800

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 <setiyowati.d...@gmail.com> 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
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
 

Kirim email ke