Maaf nih saya juga nyoba prosedur dah ta lalui Tapi ngomong-ngomong cari manggilnya gimana
From: [email protected] [mailto:[email protected]] On Behalf Of [email protected] Sent: 24 Juni 2010 8:05 To: [email protected] Subject: [belajar-access] Re: Split data Copy Paste Fungsi dan Prosedur di bawah ini ke modul baru. Jangan Lupa sesuaikan nama tabelnya. Asumsi, Tabel1 berisi kolom Job (teks), Customer (text), Jumlah (Currency) Tabel2 berisi kolom RecID(LongInt-PrimaryKey), Job (teks), Customer (text(255)), Jumlah (Currency) Anda bisa memanggil Prosedur FormatTable1ToTable2 dari command button / macro. Function ReadJob(ByVal Job As String) As String On Error GoTo ReadJob_Err Dim vRC As String 'vRC = variable Rantai Customer vRC = "" Dim rst As New ADODB.Recordset strSQL = "SELECT CUSTOMER FROM TABLE1 WHERE JOB='" & Job & "'" rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockPessimistic, adCmdText If Not (rst.BOF Or rst.EOF) Then rst.MoveLast rst.MoveFirst For i = 1 To rst.RecordCount vRC = IIf(i = 1, rst!Customer, vRC & "~~" & rst!Customer) rst.MoveNext Next End If rst.Close Set rst = Nothing ReadJob = vRC ReadJob_Keluar: Exit Function ReadJob_Err: Debug.Print "Read Job Error Is : " & Err.Number & vbCrLf & Err.Description Resume ReadJob_Keluar End Function Public Sub FormatTable1toTable2() On Error GoTo Cara2_Err 'Pembersihan Table2 strSQL = "DELETE * FROM TABLE2" CurrentDb.Execute strSQL, dbFailOnError 'Mengisi Table2 dgn data dari table1 + function ReadJob untuk mengisi Kolom Customer. Dim rst As New ADODB.Recordset strSQL = "SELECT Table1.Job, Sum(Table1.Jumlah) AS Jumlah FROM Table1 GROUP BY Table1.Job;" rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockPessimistic, adCmdText If Not (rst.BOF Or rst.EOF) Then rst.MoveLast rst.MoveFirst For vBarisKe = 1 To rst.RecordCount strSQL = "INSERT INTO Table2(RecID,Job,Jumlah,Customer) VALUES(" & vBarisKe & ",'" & rst!Job & "'," & rst!Jumlah & ",'" & ReadJob(rst!Job) & "')" CurrentDb.Execute strSQL, dbFailOnError rst.MoveNext Next End If rst.Close Set rst = Nothing Cara2_Keluar: Exit Sub Cara2_Err: Debug.Print "Read Job Error Is : " & Err.Number & vbCrLf & Err.Description Resume Cara2_Keluar End Sub
<<image001.jpg>>
<<image002.jpg>>
