| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4019 人关注过本帖, 1 人收藏
标题:请老师帮我提速一下程序
只看楼主 加入收藏
vbcaonia
Rank: 1
等 级:新手上路
帖 子:107
专家分:0
注 册:2016-5-4
结帖率:96.67%
收藏(1)
已结贴  问题点数:20 回复次数:30 
请老师帮我提速一下程序

题意是:
1、access数据库中有二个表:表1(数据)、表2(条件);表1每行数据中相邻二个数据空1格,表2每行以等号为界,等号

右边数据中相邻二个数据空1格,等号左边数据区间表示包含右边的数据个数即:1到3个。

2、表2的数据每15行一组在表1中查找,将同时符合每组15行条件的数据提取到VSFlexGrid1

表1(数据)形式:
1 2 3 7 14 15 35
1 2 3 7 17 31 36
1 2 3 7 31 33 35
1 2 3 8 14 22 30
1 2 3 8 18 25 26

表2(条件)形式:
1-3=31 12 24 7 23 3 10
1-1=35 11 16 15 17 26 3
1-1=34 31 27 24 17 33 10
1-2=28 12 6 36 7 26 33


程序运行较慢,请老师帮我修改一下程序已达到快速运行的效果,谢谢!!!


Private Sub Command1_Click() '条件过滤
t = Timer
     Dim arr(), drr(), crr(), tjrr(), tt, gx, tj, dn, pd As Long, brr, krr, ii As Long, kk As Long
    Dim Cnn As New adodb.Connection
    Dim Rst As New adodb.Recordset
    Dim Rs As New adodb.Recordset
    Dim SQL As String, myTable As String
    Set d = CreateObject("scripting.dictionary")
    Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\数据条件源.mdb;Persist Security Info=False"
    SQL = "Select * from " & "表1"
    Rst.Open SQL, Cnn, adOpenKeyset, adLockOptimistic
    ReDim crr(1 To Rst.RecordCount, 1 To 1)
    For ii = 1 To Rst.RecordCount
        crr(ii, 1) = Rst.Fields(0)
        Rst.MoveNext
    Next ii
   
    SQL1 = "Select * from " & "表2"
    Rs.Open SQL1, Cnn, adOpenKeyset, adLockOptimistic
    ReDim arr(1 To Rs.RecordCount, 1 To 1)
    For kk = 1 To Rs.RecordCount
        arr(kk, 1) = Rs.Fields(0)
        Rs.MoveNext
    Next kk


tj = 15
ReDim tjrr(1 To tj, 1 To 12)
For i = 1 To UBound(arr)
    n = n + 1
    tt = Split(arr(i, 1), "=")
    krr = Split(Trim(tt(1)), " ")
    gs = Split(tt(0), "-")
    tjrr(n, 1) = Val(gs(0))
    tjrr(n, 2) = Val(gs(1))
    For j = 0 To UBound(krr)
        tjrr(n, 3 + j) = krr(j)
Next

    If n = tj Then
        For m = 1 To UBound(crr)
            brr = Split(crr(m, 1), " ")
            For k = 1 To tj
                pd = 0
                For l = 3 To UBound(krr) + 3
                    d(tjrr(k, l)) = m
                Next
                For l = 0 To UBound(brr)
                    If d.Exists(brr(l)) Then pd = pd + 1
                Next
                d.RemoveAll
                If pd < CSng(tjrr(k, 1)) Or pd > CSng(tjrr(k, 2)) Then Exit For
            Next
            If k = tj + 1 Then dn = dn + 1: VSFlexGrid1.TextMatrix(dn, 0) = crr(m, 1)
        Next
        n = 0
    End If
Next
MsgBox Timer - t
End Sub
搜索更多相关主题的帖子: If Next 数据 For 条件 
2022-12-01 22:56
约定的童话
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:56
帖 子:246
专家分:1442
注 册:2021-8-1
收藏
得分:4 
数据库,SQL,数组,字典,能上的都上了,再慢就换电脑吧...
2022-12-02 14:38
vbcaonia
Rank: 1
等 级:新手上路
帖 子:107
专家分:0
注 册:2016-5-4
收藏
得分:0 
回复 2楼 约定的童话
这运算速度比在vba上慢一半
2022-12-02 16:31
mrexcel
Rank: 6Rank: 6
等 级:贵宾
威 望:22
帖 子:126
专家分:480
注 册:2022-11-3
收藏
得分:4 
代码优化余地很大,上个附件吧。你的数据规模没必要上ACCESS,EXCEL足够了
2022-12-03 13:35
jklqwe111
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:35
帖 子:336
专家分:1135
注 册:2014-4-13
收藏
得分:4 
应该解释一下什么样的数据叫符号条件
2022-12-03 17:44
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:4 
图片附件: 游客没有浏览图片的权限,请 登录注册

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-12-04 09:21
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:4 
可以转换为 SQL 命令,直接执行查询吗?
SQL命令是在 SQL引擎中执行,比我们代码访问所有的数据,然后一个一个的筛查要快的多,参考为什么要用 存储过程。
--------------
终极优化就是上 SQL,如 MSSQL ,然后写存储过程。


授人于鱼,不如授人于渔
早已停用QQ了
2022-12-04 11:47
vbcaonia
Rank: 1
等 级:新手上路
帖 子:107
专家分:0
注 册:2016-5-4
收藏
得分:0 
回复 4楼 mrexcel
数据为800万行,条件为14万行
2022-12-05 20:34
vbcaonia
Rank: 1
等 级:新手上路
帖 子:107
专家分:0
注 册:2016-5-4
收藏
得分:0 
回复 7楼 风吹过b
可以
2022-12-05 20:57
vbcaonia
Rank: 1
等 级:新手上路
帖 子:107
专家分:0
注 册:2016-5-4
收藏
得分:0 
回复 4楼 mrexcel
vb-数据库.rar (2.36 MB)
2022-12-06 08:50
快速回复:请老师帮我提速一下程序
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.018613 second(s), 11 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved