标题:请老师帮我提速一下程序
只看楼主
jklqwe111
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:35
帖 子:335
专家分:1125
注 册:2014-4-13
得分:0 
你理解错了,我不是说数据的规模多大,是说数据值的范围,比如 1 25 31 33 36 在1--36 范围内,看你给出的数据,最大不超过36,实际数据是不是也这样,最大值不能大于60就可以使用
2022-12-07 19:48
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 21楼 jklqwe111
老师你好,我把b1数据加到5000行,程序显示 (dataStr(dn) = str黄色)下标越界,麻烦看看问题所在,谢谢!!!

find5000.rar (29.79 KB)
2022-12-07 23:00
jklqwe111
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:35
帖 子:335
专家分:1125
注 册:2014-4-13
得分:0 
重新修改了一下,再试试
find5000.rar (29.79 KB)
2022-12-07 23:57
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 23楼 jklqwe111
老师你好,经测试速度快了很多,谢谢!!!
2022-12-08 11:36
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 21楼 jklqwe111
老师你好,测试数值时,还真是不能大于60,由于我的水平有限,想改到80没有成功,请老师指点,谢谢!
2022-12-08 23:28
jklqwe111
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:35
帖 子:335
专家分:1125
注 册:2014-4-13
得分:0 
数据最大值到底有多大
2022-12-09 19:51
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 26楼 jklqwe111
最大值等于80,谢谢!!!
2022-12-09 21:43
jklqwe111
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:35
帖 子:335
专家分:1125
注 册:2014-4-13
得分:0 
如果不大于90,改一下还是可以的,但效率肯定要下降,如果数值再大,这种方法就不适合了,以下是代码,你试一下
程序代码:

Option Explicit
Sub getmask(mk() As Long)

  Dim i As Long

  ReDim mk(1 To 30)
  mk(1) = 1
  For i = 2 To 30
  
     mk(i) = mk(i - 1) * 2
  
  Next

End Sub
Private Function number1(ByVal a As Long) As Long
  
  number1 = 0
  
  Do While a <> 0
   
    number1 = number1 + 1
    a = a And (a - 1)
  Loop
     
End Function

Private Sub Command1_Click()

    Dim mask() As Long
    Dim t As Double
    Dim data() As Long
    Dim dataStr() As String
    Dim dn As Long
    Dim n As Long
    Dim tn As Long
    Dim tj() As Long
    Dim str As String
    Dim add As Long
    Dim k As Long
    Dim i As Long
    Dim j As Long
    Dim tmp As Long
    Dim tm As Long
     
     
     t = Timer
     add = 300
         
     getmask mask

     dn = 0
     ReDim dataStr(add - 1)
     ReDim data(2, add - 1)
   
     Open App.Path & "\b1.txt" For Input As #1
   
    
     Do While Not EOF(1)
     
        Line Input #1, str
        
        If dn > UBound(dataStr) Then
           ReDim Preserve dataStr(UBound(dataStr) + add)
           ReDim Preserve data(2, UBound(data, 2) + add)
        End If
        dataStr(dn) = str
        
        k = 1
       
        Do While 1
        
           n = InStr(k, str, " ")
           If n <> 0 Then
              tmp = Val(Mid(str, k, n - k))
              If tmp <= 30 Then
                  data(0, dn) = data(0, dn) Or mask(tmp)
              ElseIf tmp >= 31 And tmp <= 60 Then
                  data(1, dn) = data(1, dn) Or mask(tmp - 30)
              ElseIf tmp >= 61 And tmp <= 90 Then
                  data(2, dn) = data(2, dn) Or mask(tmp - 60)
              End If
            Else
              tmp = Val(Mid(str, k, Len(str)))
              If tmp > 0 And tmp <= 30 Then
                  data(0, dn) = data(0, dn) Or mask(tmp)
              ElseIf tmp >= 31 And tmp <= 60 Then
                  data(1, dn) = data(1, dn) Or mask(tmp - 30)
              ElseIf tmp >= 61 And tmp <= 90 Then
                  data(2, dn) = data(2, dn) Or mask(tmp - 60)
            
              End If
              Exit Do
            End If
           
            k = n + 1
            
         Loop
         dn = dn + 1
     Loop
     Close #1

 
     tm = Val(Text1)
     
     tn = 0
    
     ReDim tj(4, tm - 1)
     
     Open App.Path & "\b2.txt" For Input As #1
   
   
     Do While Not EOF(1)
     
        Line Input #1, str
        
        k = 1
         
        n = InStr(k, str, "-")
         
        tmp = Val(Mid(str, 1, n - 1))
        tj(3, tn) = tmp
         
        k = n + 1
        n = InStr(k, str, "=")
         
        tmp = Val(Mid(str, k, n - 1))
        tj(4, tn) = tmp
        k = n + 1
        Do While 1
        
           n = InStr(k, str, " ")
           If n <> 0 Then
              tmp = Val(Mid(str, k, n - k))
              If tmp <= 30 Then
                  tj(0, tn) = tj(0, tn) Or mask(tmp)
              ElseIf tmp >= 31 And tmp <= 60 Then
                  tj(1, tn) = tj(1, tn) Or mask(tmp - 30)
              ElseIf tmp >= 61 And tmp <= 90 Then
                  tj(2, tn) = tj(2, tn) Or mask(tmp - 60)
              End If
            Else
              tmp = Val(Mid(str, k, Len(str)))
              If tmp > 0 And tmp <= 30 Then
                  tj(0, tn) = tj(0, tn) Or mask(tmp)
              ElseIf tmp >= 31 And tmp <= 60 Then
                  tj(1, tn) = tj(1, tn) Or mask(tmp - 30)
              ElseIf tmp >= 61 And tmp <= 90 Then
                  tj(2, tn) = tj(2, tn) Or mask(tmp - 60)
              End If
              Exit Do
            End If
           
            k = n + 1
         Loop
         
        tn = tn + 1
        If tn = tm Then
           For i = 0 To dn - 1
                For j = 0 To tn - 1
                    tmp = number1(data(0, i) And tj(0, j)) + number1(data(1, i) And tj(1, j)) + number1(data(2, i) And tj(2, j))
                    If tmp < tj(3, j) Or tmp > tj(4, j) Then
                   
                      Exit For
             
                    End If
                    
               Next
           If j = tn Then Me.List1.AddItem dataStr(i)
           
           Next
           
           tn = 0
            ReDim tj(4, tm - 1)
        End If
               
   Loop
   
  Close #1
    
  Text2 = Timer - t
  Text3 = Me.List1.ListCount
  Text4 = Me.List2.ListCount
End Sub
收到的鲜花
  • vbcaonia2022-12-10 08:37 送鲜花  6朵  
2022-12-09 23:01
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 28楼 jklqwe111
谢谢指点!!!
2022-12-10 08:35
vbcaonia
Rank: 1
等 级:新手上路
帖 子:97
专家分:0
注 册:2016-5-4
得分:0 
回复 28楼 jklqwe111
老师你好:
查找按钮中的程序,我想将原:
Open App.Path & "\b1.txt" For Input As #1的数据来源改为文本框text4.text
Open App.Path & "\b2.txt" For Input As #1的数据来源改为文本框text5.text
运行时越界,烦请老师看看,谢谢!!!
问题:
data(1, dn) = data(1, dn) Or mask(tmp - 30)



vb--查找.rar (4.99 KB)
2022-12-24 18:52



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-510839-1-1.html




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

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