[已解决]请高手帮我把这个筛选程序优化一下，总感觉慢了点

jessylake

按表选择需要的单词打印成单词条10.rar (33.09 KB, 下载次数: 6)

2014-9-24 19:33 上传

点击文件名下载附件   总感觉慢了点，不知有没有更先进的方法

特别是把单词从打印去移回选择区的时候，不知还有什么高招？

最佳答案

月排行榜 / 总排行榜

zjdh

2014-9-24 20:03

Private Sub CommandButton5_Click()
    tim = Timer
    Dim BRR()
    Set D = CreateObject("scripting.dictionary")
    For I = 1 To UBound(Arr)
        If TextBox2 <> "" Then
            If InStr(Arr(I, 1) & Arr(I, 2), LCase(TextBox2.Value)) Then
                D(Arr(I, 1)) = Arr(I, 2)
            End If
        Else
            D(Arr(I, 1)) = Arr(I, 2)
        End If
    Next
    With ListBox2
        For I = .ListCount - 1 To 0 Step -1
            If Not .Selected(I) Then
                If D.exists(.List(I, 0)) Then D.Remove .List(I, 0)
            Else
                .RemoveItem (I)
                TextBox4.Value = TextBox4.Value - 1
            End If
        Next
    End With
    K = D.KEYS
    T = D.ITEMS
    ReDim BRR(1 To D.Count, 1 To 2)
    For I = 0 To D.Count - 1
        BRR(I + 1, 1) = K(I)
        BRR(I + 1, 2) = T(I)
    Next
    With ListBox1
        .Clear
        .List = BRR
    End With
    TextBox3 = D.Count
    MsgBox "总计用时 " & Format(Timer - tim, "0.00") & " 秒!!", 64, "提示"
End Sub

跳转到最佳答案楼层

zjdh

Private Sub CommandButton5_Click()
    tim = Timer
    Dim BRR()
    Set D = CreateObject("scripting.dictionary")
    For I = 1 To UBound(Arr)
        If TextBox2 <> "" Then
            If InStr(Arr(I, 1) & Arr(I, 2), LCase(TextBox2.Value)) Then
                D(Arr(I, 1)) = Arr(I, 2)
            End If
        Else
            D(Arr(I, 1)) = Arr(I, 2)
        End If
    Next
    With ListBox2
        For I = .ListCount - 1 To 0 Step -1
            If Not .Selected(I) Then
                If D.exists(.List(I, 0)) Then D.Remove .List(I, 0)
            Else
                .RemoveItem (I)
                TextBox4.Value = TextBox4.Value - 1
            End If
        Next
    End With
    K = D.KEYS
    T = D.ITEMS
    ReDim BRR(1 To D.Count, 1 To 2)
    For I = 0 To D.Count - 1
        BRR(I + 1, 1) = K(I)
        BRR(I + 1, 2) = T(I)
    Next
    With ListBox1
        .Clear
        .List = BRR
    End With
    TextBox3 = D.Count
    MsgBox "总计用时 " & Format(Timer - tim, "0.00") & " 秒!!", 64, "提示"
End Sub

jessylake

zjdh 发表于 2014-9-24 20:03
Private Sub CommandButton5_Click()
    tim = Timer
    Dim BRR()

试了一下，感觉没问题，就是挪过来，再加个蓝色选中，就更直观了

对字典还不熟，慢慢研究，真心感谢老师！

仔细看了看，非筛选表中的单词是过不去的，变蓝好像也不太好处理，视觉上的移动效果不是很直观，不过可以再研究研究，虽然没有实际意义，权当学习吧

jessylake

zjdh 发表于 2014-9-24 20:03
Private Sub CommandButton5_Click()
    tim = Timer
    Dim BRR()

老师我把字典功能加到原来的代码中，保留了原来的随便来回移动功能，不知道是不是数据量少，速度上看不出什么变化

按表选择需要的单词打印成单词条11.rar (36.6 KB, 下载次数: 4)

2014-9-24 22:58 上传

点击文件名下载附件

jessylake

我把字典的功能基本上都用进去了，不知道效率有没有提高