怎样按条件将一条记录拆分为几条记录？求助!

Henry D. Sy

1. Private Sub Command2_Click()
   
2.     Dim rs As New ADODB.Recordset
   
3.     Dim rs1 As New ADODB.Recordset
   
4.     Dim rs2 As New ADODB.Recordset
   
5.     Dim cnn As New ADODB.Connection
   
6.     Dim str As String
   
7.     Dim str1 As String
   
8.     Dim str2 As String
   
9.     Dim x As Double
   
10.     Dim y As Double
    
11.     Dim curM As Double
    
12.     Dim i As Integer
    
13. 
    
14.     On Error GoTo Command2_Click_Error
    
15. 
    
16.     Set cnn = CurrentProject.Connection
    
17.     i = 1
    
18.     CurrentDb.Execute "delete * from newtbl"
    
19.     Me.Newtbl_子窗体.Requery
    
20. 
    
21.     str = "SELECT DISTINCT 记录表.姓名 FROM 记录表"
    
22.     rs.Open str, cnn, adOpenKeyset, adLockReadOnly
    
23.     Do Until rs.EOF
    
24.         y = 50000
    
25.         str1 = "SELECT 贷方 FROM 记录表 WHERE 姓名='" & rs.Fields(0) & "' And Not 贷方 Is Null"
    
26.         rs1.Open str1, cnn, adOpenKeyset, adLockReadOnly
    
27.         x = rs1.Fields(0)
    
28. 
    
29.         str2 = "SELECT * FROM Newtbl"
    
30.         rs2.Open str2, cnn, adOpenKeyset, adLockOptimistic
    
31.         Do Until x <= 0
    
32. 
    
33.             If x >= 50000 Then
    
34.                 curM = y - i
    
35.                 x = x - y + i
    
36.             Else
    
37.                 curM = x
    
38.                 x = x - y
    
39.             End If
    
40.             i = i + 1
    
41.             rs2.AddNew
    
42.             rs2.Fields(0) = rs.Fields(0)
    
43.             rs2.Fields(1) = curM
    
44.             rs2.Update
    
45.         Loop
    
46.         rs2.Close
    
47.         rs1.Close
    
48.         rs.MoveNext
    
49.     Loop
    
50.     rs.Close
    
51.     Set rs = Nothing
    
52.     Set rs1 = Nothing
    
53.     Set rs2 = Nothing
    
54.     Set cnn = Nothing
    
55.     Me.Newtbl_子窗体.Requery
    
56. 
    
57.     On Error GoTo 0
    
58.     Exit Sub
    
59. 
    
60. Command2_Click_Error:
    
61. 
    
62.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    
63. End Sub
    

复制代码

Henry D. Sy

yehf 发表于 2011-9-30 16:37
再简化下代码
Private Sub Command2_Click()
    Dim rst    As Recordset

lz要求，同一个人或者不同姓名，所有的尾数不同