RE: [belajar-excel] Tanya Macro

[Posi, Yugustin (PTI-SOR)]

Dear Ibu Siti yang baik,

Terimakasih untuk pengertiannya :-)

 

Sangat membantu untuk menyelesaikan tugas saya.

 

Sampai jumpa dipertanyaan berikutnya :-) (maap ya... untuk saat ini baru
bisa bertanya aja..., kapan ya bisa seperti Ibu Siti??? )

 

Salam,

gusti

 

________________________________

From: belajar-excel@yahoogroups.com
[mailto:belajar-ex...@yahoogroups.com] On Behalf Of siti Vi
Sent: Thursday, February 04, 2010 6:22 PM
To: belajar-excel@yahoogroups.com
Subject: Re: [belajar-excel] Tanya Macro

 

  

oh begitu..

ya udah....

jadi ... makro dibuat baru ( dari a SAMPAI z) tanpa mengingat bangunan 

yg telah dibuat oleh pak gusti (yg tidak boleh dilihat orang) he he he..

 

maksudnya kan gini:

dengan bagian yg telah ada itu, si penanggap hanya perlu bikin

bagian bagian yg berkendala, bukan dari a samapi z lagi...

(belum ke situ ya arahnya..)

 

Sub ctv_Sub_And_Product_Total()
   '--------------------------------------------------------------
   ' siti Vi // 4 feb 2010
   ' for milis [belajar excel]
   ' posting ref:
   ' http://tech.groups.yahoo.com/group/belajar-excel/message/3374
<http://tech.groups.yahoo.com/group/belajar-excel/message/3374> 
   '--------------------------------------------------------------
   Dim UniqFR, UniqLV
   Dim TBLRef As Range
   Dim Hatsil As Range
   Dim NewSht As Worksheet
   Dim TbRow As Long
   Dim DR As Double, C As Double, N As Double
   Dim i As Long, a As Long, b As Long, r As Long
   
   Set TBLRef = Sheets("Data Awal").Cells(1).CurrentRegion
   TbRow = TBLRef.Rows.Count - 1
   Set TBLRef = TBLRef.Offset(1, 0).Resize(TbRow, TBLRef.Columns.Count)
   
   Set NewSht = Worksheets.Add
   NewSht.Name = "Hasil" & ActiveSheet.Name
   NewSht.Move After:=Sheets(Sheets.Count)
   Set Hatsil = NewSht.Cells(1)
   Columns("A:A").NumberFormat = "@"
   TBLRef(0, 1).Resize(1, TBLRef.Columns.Count).Copy Hatsil
   
   UniqFR = LOUV(TBLRef.Resize(TbRow, 1))
   UniqLV = LOUV(TBLRef.Offset(0, 1).Resize(TbRow, 1))
   r = 1
   Application.Calculation = xlCalculationManual
   For b = 1 To UBound(UniqLV)
      For a = 1 To UBound(UniqFR)
         For i = 1 To TbRow
            If TBLRef(i, 2) = UniqLV(b) And _
               TBLRef(i, 1) = UniqFR(a) Then
               r = r + 1
               DR = DR + TBLRef(i, 3)
               C = C + (TBLRef(i, 3) * TBLRef(i, 4))
               N = N + (TBLRef(i, 3) * TBLRef(i, 5))
               
               Hatsil(r, 1) = UniqFR(a)
               Hatsil(r, 2) = UniqLV(b)
               Hatsil(r, 3) = TBLRef(i, 3)
               Hatsil(r, 4) = TBLRef(i, 4)
               Hatsil(r, 5) = TBLRef(i, 5)
            End If
         Next i
         r = r + 1
         Hatsil(r, 3) = DR
         Hatsil(r, 4) = C / DR
         Hatsil(r, 5) = N / DR
         DR = 0: C = 0: N = 0
      Next a
   Next b
   Application.Calculation = xlCalculationAutomatic

 

End Sub

 

    

________________________________

----- Original Message ----- 
From: Posi, Yugustin (PTI-SOR) 
To: belajar-excel@yahoogroups.com 
Sent: Thursday, February 04, 2010 3:59 PM
Subject: RE: [belajar-excel] Tanya Macro

Ok Ibu Siti,
Dari macro yang saya buat itu, tinggal ini kendalanya,
Makanya saya copy ke workbook baru saja (supaya filenya tidak berat).
Harapannya setelah mendapatkan solusi, bahasanya akan saya gabungkan 

dengan macro yang sudah saya buat.
 
Terimakasih,
Salam,
gusti



Internal Virus Database is out of date.
Checked by AVG.
Version: 8.0.101 / Virus Database: 270.4.0/1513 - Release Date:
6/22/2008 7:52 AM