Tecnologia, programação e muito Visual FoxPro.

sábado, 30 de janeiro de 2010

Re: ]] XL-mania [[ Otomatisasi schedule produksi x total point

 

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
   '    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
         ' --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
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: Myeko
Sent: Thursday, January 28, 2010 3:54 PM
Subject: ]] XL-mania [[ Otomatisasi schedule produksi x total point

Selamat 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              |
+-------------------------------------------------------------------+
.

__,_._,___

Nenhum comentário:

Arquivo do blog