Private Sub Command1_Click()
Dim Conn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim i As Integer
Set Conn = CurrentProject.Connection
Conn.Execute "delete * from table4"
Rs.Open "select * from table4", Conn, adOpenDynamic, adLockOptimistic
rst.Open "select * from table1 where 合计金额>0", Conn, adOpenDynamic, adLockOptimistic
Do While Not rst.EOF
For i = 5 To rst.Fields.Count - 1
Rs.AddNew
Rs("编号") = rst("编号")
Rs("姓名") = rst("姓名")
Rs("收费项目") = rst.Fields(i).Name
Rs("金额") = rst(i)
Rs.Update
Next
rst.MoveNext
Loop
MsgBox "完成", 64
End Sub