Bismillahirrohmanirrohim..., Dugaan spekulatif saya kelambatan bisa karena: 1. Terlalu banyak record yang akan di masukkan ke tabel dbo_Projection_Cost. 2. Terlalu banyak membuat recordset. Apalagi tidak segera ditutup dan dihilangkan dari memory (set rs.close set rs=nothing) 3. Pada deklarasi utama tidak disebukan option explicit (semua variable didefinisikan, bukan mesin yang mendefinisikan. Mesin difungsikan hanya mengeksekusi) Jalan keluar untuk yang ke-2: 1. coba buat variabel (dim aa as variant). 2. Buka recorrset (set rs = currentdb.openrecordset("NamaTabel") 3. Ambil nilai yang dikehendaki (aa = rs.field(0)) 4. Tutup dan hilangkan dari memory (set rs.close set rs=nothing) Bila ingin menggunakan rs, gunakan lagi dengan cara sama. Coba uji dengan menghentikan proses script hingga: .... Next scan
db.TableDefs.Append tbldef1
Dibawah ini coba dihapus dulu
fequipment.MoveLast
fequipment.MoveFirst
tblarr1 = fequipment.GetRows(fequipment.RecordCount) 'Load Data to array table
...
Kalau terasa lebih ringan. Berarti yang membuat lambat adalah proses insert data (mengingat jumlah data 50 ribu buah). Pengalaman saya, addnew dengan model recordset memang agak lambat. Yang lebih cepat memakai insert into tabel. Dalam kasus Sampeyan, script bisa dicoba dengan: script semula: Set pcost = db.OpenRecordset("Select * from dbo_Projection_Cost")
'Looping
DoCmd.OpenForm "f_progress"
For Rw = 0 To UBound(tblarr1, 2)
pcost.AddNew
For Cl = 0 To UBound(tblarr1, 1)
With Form_f_progress
.Caption = "Update Record " & Rw & " of " & UBound(tblarr1, 2)
.l_bar.Width = (Rw / UBound(tblarr1, 2)) * .L_Process
.L_Process.Visible = False
.l_judul.Visible = False
End With
pcost.Fields(Cl).Value = UCase(tblarr1(Cl, Rw))
Next Cl
pcost.Update
pcost.MoveNext
Next Rw
ubah dengan: Set db = CurrentDb
DoCmd.OpenForm "f_progress"
For Rw = 0 To UBound(tblarr1, 2)
For Cl = 0 To UBound(tblarr1, 1)
With Form_f_progress
.Caption = "Update Record " & Rw & " of " & UBound(tblarr1, 2)
.l_bar.Width = (Rw / UBound(tblarr1, 2)) * .L_Process
.L_Process.Visible = False
.l_judul.Visible = False
End With
'pakai ini bila type data field CI number db.Execute "insert into dbo_Projection_Cost (Cl)" _
& " values (" & UCase(tblarr1(Cl, Rw)) & ")" 'atau pakai ini bila type data field CI text 'db.Execute "insert into dbo_Projection_Cost (Cl)" _
& " values ('" & UCase(tblarr1(Cl, Rw)) & "')" Next Cl
Next Rw
db.close set db = nothing Semoga bisa membantu dan memberi semangat. Hariyanto (Surabaya)
--- On Thu, 23/5/13, nafan.muhammad <nafan.muhammad@yahoo.com> wrote:
From: nafan.muhammad <nafan.muhammad@yahoo.com>
Subject: [belajar-access] Access Loop
To: belajar-access@yahoogroups.com
Date: Thursday, 23 May, 2013, 3:23 PM
Dear Agan2, ada yang bisa bantu gak?
Dengan menggunakan script di bawah masih lumayan lambat. jumlah row 50.000, dan untuk membuat proyeksi kost selama 5 tahun kedepan jadi semakin lambat...
ada solusi?
Sub Projection_Cost_A()
On Error Resume Next
'SET PRIORITY TO ABOVE NORMAL
Const ABOVE_NORMAL = 32768
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'MSACCESS.exe'")
For Each objProcess In colProcesses
objProcess.SetPriority (ABOVE_NORMAL)
Next
Dim awal As Long
Dim sekarang As Long
Dim selesai As Long
Dim scan As Long
Dim maxkolom As Long
Dim kolom As String
Dim fR As Long
Dim fC As Long
Dim fScan As Long
'Array Component
Dim tblarr1 As Variant
Dim tblarr2 As Variant
Dim Rw As Long
Dim Cl As Long
Dim ArrScan As Long
'Database Component
Dim db As Database
Dim actcost As Recordset
Dim fequipment As Recordset
Dim pcost As Recordset
Dim Maxdate As Recordset
Dim qrydef1 As QueryDef
Dim qrydef2 As QueryDef
Dim tbldef1 As TableDef
Dim mysql As String
finddatabase 'Mencari Database Location
Set db = CurrentDb()
Set Maxdate = db.OpenRecordset("Select MAX(dbo_asset_master.[disposal date]) as [Disposal Date] from dbo_Asset_Master")
Set fequipment = db.OpenRecordset("Select dbo_Asset_Master.[Group], dbo_Asset_Master.[Machine_Model], dbo_equipment_forecast.* from dbo_equipment_forecast INNER JOIN dbo_asset_master on dbo_equipment_forecast.[assetid] = dbo_asset_master.[assetid] Where dbo_asset_master.[group]='" & Form_f_forecast_dialog3.Group & "'")
db.TableDefs.delete "dbo_projection_cost" 'Delete Table Sebelumnya...
Set tbldef1 = db.CreateTableDef("dbo_projection_cost")
'Membuat fields table sesuai dengan table equipment forecast
For fScan = 0 To fequipment.Fields.Count
With tbldef1
.Fields.Append .CreateField(UCase(fequipment.Fields(fScan).Name), fequipment.Fields(fScan).Type)
End With
Next fScan
'Membuat fields sesuai dengan bulan hingga 5 tahun
awal = Format("1/1/" & Year(Date), 0)
sekarang = Format(Date, 0)
selesai = Format(Maxdate![Disposal Date], 0)
maxkolom = 0
For scan = awal To selesai
If Format(scan, "d") = 1 Then
maxkolom = maxkolom + 1
If maxkolom <= 60 Then
kolom = Format(scan, "mmm-yy")
With tbldef1
.Fields.Append .CreateField(UCase(kolom), dbCurrency)
.Fields(kolom).DefaultValue = 0
End With
End If
End If
Next scan
db.TableDefs.Append tbldef1
fequipment.MoveLast
fequipment.MoveFirst
tblarr1 = fequipment.GetRows(fequipment.RecordCount) 'Load Data to array table
Set pcost = db.OpenRecordset("Select * from dbo_Projection_Cost")
'Looping
DoCmd.OpenForm "f_progress"
For Rw = 0 To UBound(tblarr1, 2)
pcost.AddNew
For Cl = 0 To UBound(tblarr1, 1)
With Form_f_progress
.Caption = "Update Record " & Rw & " of " & UBound(tblarr1, 2)
.l_bar.Width = (Rw / UBound(tblarr1, 2)) * .L_Process
.L_Process.Visible = False
.l_judul.Visible = False
End With
pcost.Fields(Cl).Value = UCase(tblarr1(Cl, Rw))
Next Cl
pcost.Update
pcost.MoveNext
Next Rw
DoCmd.Close acForm, "f_Progress"
pcost.MoveLast
pcost.MoveFirst
tblarr2 = pcost.GetRows(pcost.RecordCount) 'Load data projection cost
'Calculate projection...
Dim sFreq As Long
Dim WH As Long
Dim kelipatan As Long
Dim ScanFreq As Long
Dim MaxChange As Date
Dim SInterval As Long
fequipment.Close
Maxdate.Close
db.Close
End Sub
| 
Tidak ada komentar:
Posting Komentar