下面用VB字典实现查找:
Dim Dic As Object
Dim p As Byte
Dim r As Integer, f As Integer, i As Integer,fn As Integer
Dim kv As String, iv As String, tmp As String,Arr() As String
Private Sub dicFind()
Set Dic = CreateObject("Scripting.dictionary") '创建字典对象
Dic.CompareMode = vbTextCompare
With Form1.Grid(0) '为字典添加关键字(索引)
For r = 1 To .Rows - 1
kv = .TextMatrix(r, 1) & .TextMatrix(r, 2)
iv = .TextMatrix(r, 3) & "|" & .TextMatrix(r, 5) & "|" & .TextMatrix(r, 6)
Dic.Item(kv) = Dic(kv) + iv
Next r
End With
With Form1.Grid(1)
.Cell(flexcpText, 1, 3, .Rows - 1, 5) = ""
.Cell(flexcpForeColor, 1, 3, .Rows - 1, 5) = vbBlue
.Cell(flexcpAlignment, 1, 3, .Rows - 1, 5) = 4
For r = 1 To .Rows - 1
tmp = .TextMatrix(r, 1) & .TextMatrix(r, 2)
If Dic.Exists(tmp) Then
iv = Dic(tmp) '获取其key对应的item信息,即:日期、编号、等级
Arr() = Split(iv, "|")
.TextMatrix(r, 3) = Arr(0)
.TextMatrix(r, 4) = Arr(1)
.TextMatrix(r, 5) = Arr(2)
Else
.Cell(flexcpText, r, 3, r, 5) = "无"
.Cell(flexcpForeColor, r, 3, r, 5) = vbRed
End If
Next
End With
Dic.RemoveAll: Set Dic = Nothing ' 销毁对象变量
End Sub
Private Sub Cmdbtn_Click()
Call dicFind
End Sub
执行查找命令后,结果如下:
图中绿色区是查找结果:从下表中找到的对应信息,写入上表 。
该表实际有3500行数据,基本上数秒见完成,可见VB字典功能强大之一斑。