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
