saya punya pemecahnya, tetapi belum tentu dapat memecahkan..
Sub TotalPointTable()
'-------------------------------------------------
' siti Vi / bluewater / 30 jan 2010
' case:
' http://tech.groups.yahoo.com/group/XL-mania/message/14813
'-----------
' siti Vi / bluewater / 30 jan 2010
' case:
'
' kita pilih jalan yg muter biar makronya kelihatan "meNgerikan"
'------------------------------------------------
'------------
Dim NewSheet As Worksheet
Dim NewTabel As Range
Dim dbTCust As Range
Dim dbTModel As Range
Dim Krite_1 As String
Dim Krite_2 As String
Dim nRow As Long
Dim nCol As Integer
Dim TPoint, AkumTR, AkumGT
Dim r As Long, i As Long, n As Long, c As Integer
'--penugasan kpd para variables dan beberapa tindakan medis--
RefreshDBase
Krite_1 = Range("C6")
Range("B7").CurrentRegion.Copy
Set NewSheet = Sheets.Add
With NewSheet
'--menyalin tabel SOAL ke sheet baru--
.Cells(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
nRow = .UsedRange.Rows.Count
nCol = .UsedRange.Columns.Count
Application.CutCopyMode = False
'--kolom pertama dibuang
.Columns("A:A").Delete Shift:=xlToLeft
Set NewTabel = .Cells(1).Resize(nRow, nCol - 1)
End With
'--empty-rows juga dibuang
For i = nRow To 1 Step -1
If Len(NewTabel(i, 1)) = 0 Then NewTabel(i, 1).EntireRow.Delete
Next i
'--memperbaharui pengenalan dimensi tabelbaru
' (karena 'kan baru saja di-obok-obok..)
Set NewTabel = NewSheet.Cells(3, 1).CurrentRegion.Offset(2, 0)
With NewTabel
Set NewTabel = .Resize(.Rows.Count - 2, .Columns.Count)
nRow = .Rows.Count
nCol = .Columns.Count
End With
'--kolom² kriteria pada tabel database
Set dbTCust = dbTPoint.Resize(nDbRow, 1)
Set dbTModel = dbTCust.Offset(0, 2)
'--proses pencocokan dgn kriteria, pencarian nilai tpoint
'--dan menulisan hasil di tabel baru
For n = 1 To nRow
Krite_2 = NewTabel(n, 1).Value
AkumTR = 0
If dbTCust(n, 1) = Krite_1 Then
Dim NewTabel As Range
Dim dbTCust As Range
Dim dbTModel As Range
Dim Krite_1 As String
Dim Krite_2 As String
Dim nRow As Long
Dim nCol As Integer
Dim TPoint, AkumTR, AkumGT
Dim r As Long, i As Long, n As Long, c As Integer
'--penugasan kpd para variables dan beberapa tindakan medis--
RefreshDBase
Krite_1 = Range("C6")
Range("B7").
Set NewSheet = Sheets.Add
With NewSheet
'--menyalin tabel SOAL ke sheet baru--
.Cells(1).PasteSpec
.Cells(1).PasteSpec
nRow = .UsedRange.Rows.
nCol = .UsedRange.Columns.
Application.
'--kolom pertama dibuang
.Columns("A:
Set NewTabel = .Cells(1).Resize(
End With
'--empty-rows juga dibuang
For i = nRow To 1 Step -1
If Len(NewTabel(
Next i
'--memperbaharui pengenalan dimensi tabelbaru
' (karena 'kan baru saja di-obok-obok.
Set NewTabel = NewSheet.Cells(
With NewTabel
Set NewTabel = .Resize(.Rows.
nRow = .Rows.Count
nCol = .Columns.Count
End With
'--kolom² kriteria pada tabel database
Set dbTCust = dbTPoint.Resize(
Set dbTModel = dbTCust.Offset(
'--proses pencocokan dgn kriteria, pencarian nilai tpoint
'--dan menulisan hasil di tabel baru
For n = 1 To nRow
Krite_2 = NewTabel(n, 1).Value
AkumTR = 0
If dbTCust(n, 1) = Krite_1 Then
' --lihat ada fungsi ctv_Countif dan ctv_Match...
If ctv_Countif(dbTModel, Krite_2) > 0 Then
r = ctv_Match(Krite_2, dbTModel, 0)
TPoint = dbTModel(r, 2).Value
For c = 2 To nCol - 1
NewTabel(n, c) = NewTabel(n, c) * TPoint
AkumTR = AkumTR + NewTabel(n, c).Value
Next c
NewTabel(n, c) = AkumTR
AkumGT = AkumGT + AkumTR
End If
End If
Next n
NewTabel(n, c) = AkumGT
'--demi enak dipandang mata saja...
NewSheet.Move After:=Sheets(Sheets.Count)
NewSheet.Name = "New" & NewSheet.Name
Cells(1).Select
If ctv_Countif(dbTModel, Krite_2) > 0 Then
r = ctv_Match(Krite_2, dbTModel, 0)
TPoint = dbTModel(r, 2).Value
For c = 2 To nCol - 1
NewTabel(n, c) = NewTabel(n, c) * TPoint
AkumTR = AkumTR + NewTabel(n, c).Value
Next c
NewTabel(n, c) = AkumTR
AkumGT = AkumGT + AkumTR
End If
End If
Next n
NewTabel(n, c) = AkumGT
'--demi enak dipandang mata saja...
NewSheet.Move After:=Sheets(
NewSheet.Name = "New" & NewSheet.Name
Cells(1).Select
End Sub
'----------------
'-----------
mengharap dengan penuh permintaan belas-kasihan untuk diberi sekedar kabar
'work'/'not work'nya coding ini
(statistik membuktikan: tiap 100 solusi, yg ada khabarnya cuma 8.76%)
tatacara beremail & bermilis 'orang sekarang' sudah jauh berbeda dibanding 2 - 3 th yl.
~siti~
----- Original Message -----From: MyekoSent: Thursday, January 28, 2010 3:54 PMSubject: ]] XL-mania [[ Otomatisasi schedule produksi x total pointSelamat sore
Saya mempunyai case yang ingin dipecahkan mengenai penghitungan
perkalian jumlah qty produksi dengan Jumlah total Point part terpasang
setiap hari schedule dari customer selalu berubah tiap hari qty bisa
dilihat di schedule
untuk memudahkan proses estimasi dan penghitungan capasitas line
produksi maka untuk total produksi harus dikalikan dengan total point
sesuai Model
seperti sample sheet yang saya lampirkan disini ada 3 sheet
sheet 1 : Schedule dari PT perkasa
sheet 2 : Summary Database total Point ( per model per point part terpasang )
sheet ini akan selalu updated dengan model-model yang lain/baru
Saya ingin dengan menggunakan makro, maka hanya dengan menekan tombol
(...)maka proses penghitungan capasitas produksi bisa dilakukan dengan
otomatis
( qty di schedule langsung kali total point ) dan dalam sheet yang baru
Mohon bantuannya kepada para pakar excel untuk solusi dan pencerahanya
( sample data terlampir )
demikian saya sampaikan terimakasih
MYEKO.BUDI
__._,_.___
+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Member ke 13,013 siapa ya? Sini mau dikirimin coklat :D |
| Member ke 31,031 dapet iPod dehh.... :D :D :D |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
| Member ke 13,013 siapa ya? Sini mau dikirimin coklat :D |
| Member ke 31,031 dapet iPod dehh.... :D :D :D |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
.
__,_._,___
Nenhum comentário:
Postar um comentário