处理有重复值问题
先生好，我有这样一个问题：从有20个数据的原表中取数，求出符合条件的值写入结果表，但在写入结果表中有许多在同一条记录中有重复值，现在想若同一条记录中有重复值，则程序自动跳过（不写入结果表中，因如果全部写入则结果表会超过2G，程序无法完成），现在代码如下，请添加代码以达到“同一条记录中若有相同值则不写入结果表，继续执行循环代码”，谢谢（原表、结果表、工程文件等均在附件中）Dim bs(1 To 20) As Long
Private Sub form_LOAD()
Dim Conn As New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\结果表.mdb"
Conn.Execute "delete * from B1"
End Sub
Private Sub form_CLICK()
Dim cn1 As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
cn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\原表.mdb"
rs1.Open "b1", cn1, 1, 3
Me.WindowState = 0
'--------------------
Debug.Print
最小数 = -10
最大数 = 20
For i = 1 To 20
bs(i) = rs1.Fields("变量").Value
rs1.MoveNext
Debug.Print bs(i);
Next i
Debug.Print
Debug.Print
'----------------
常数1 = 0
For i = 1 To 20
常数1 = 常数1 + bs(i)
Next i
rs1.Close
常数 = 常数1 / 5
Debug.Print ; "--常数="; Space(1) & 常数 & Space(1); "！"
'-------------------------------------------------------
Dim FF1cn1 As New ADODB.Connection
Dim FF1rs1 As New ADODB.Recordset
FF1cn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\结果表.mdb"
FF1rs1.Open "b1", FF1cn1, 1, 3
FF1rs1.AddNew
'------------------------------------------------------
kk = 20
For h1 = 1 To kk
j = bs(h1)
For h2 = 1 To kk
k = bs(h2)
For h3 = 1 To kk
l = bs(h3)
For h4 = h3 + 1 To kk
n = bs(h4)
For h5 = h3 + 1 To kk
o = bs(h5)
For h6 = h4 + 1 To kk
p = bs(h6)
For h7 = h4 + 1 To kk
r = bs(h7)
For h8 = h5 + 1 To kk
s = bs(h8)
For h9 = h5 + 1 To kk
t = bs(h9)
'------------------x即为常数
x = 常数
a = l + r + k + n - 2 * x + j + s + t + o + p
b = -2 * x + k + 2 * p + s + r + 2 * t + l + o
c = 6 * x - j - 3 * k - 4 * p - 4 * s - 3 * r - 4 * t - 2 * l - 2 * o
d = -x + k + p + 2 * s - n + r + t
e = 3 * x - j - k - 2 * p - s - r - 2 * t - l - o - n
f = -5 * x + j + 3 * k + 4 * p + 4 * s + 2 * r + 4 * t + 2 * l + o
g = x - k - p - s
h = -2 * s + n - r + 2 * x - p - 2 * t - k - l
i = x - j - k - l
m = x - n - o - p
q = x - r - s - t
'-------------------------------
If 最小数 <= a And a <= 最大数 And 最小数 <= b And b <= 最大数 And 最小数 <= c And c <= 最大数 And 最小数 <= d And d <= 最大数 And 最小数 <= e And e <= 最大数 And 最小数 <= f _
And f <= 最大数 And 最小数 <= g And g <= 最大数 And 最小数 <= h And h <= 最大数 And 最小数 <= i And i <= 最大数 And 最小数 <= m And m <= 最大数 And 最小数 <= q And q <= 最大数 Then
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"~"块内写入ACCESS
FF1rs1("列1") = a
FF1rs1("列2") = b
FF1rs1("列3") = c
FF1rs1("列4") = d
FF1rs1("列5") = e
FF1rs1("列6") = f
FF1rs1("列7") = g
FF1rs1("列8") = h
FF1rs1("列9") = i
FF1rs1("列10") = j
FF1rs1("列11") = k
FF1rs1("列12") = l
FF1rs1("列13") = m
FF1rs1("列14") = n
FF1rs1("列15") = o
FF1rs1("列16") = p
FF1rs1("列17") = q
FF1rs1("列18") = r
FF1rs1("列19") = s
FF1rs1("列20") = t
FF1rs1.Update
FF1rs1.AddNew
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Else
End If
Next h9
Next h8
Next h7
Next h6
Next h5
Next h4
Next h3
Next h2
Next h1
'-------------
Set FF1rs1 = Nothing
Set FF1cn1 = Nothing
MsgBox " 本次运行结束！"
End Sub
请教.rar
(19.87 KB)
[ 本帖最后由 fdxxhjc 于 2015-8-19 13:22 编辑 ]
