|
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i&, j%, t%, myStr$, k&, N$, P$
Dim LG As Boolean, arr1()
On Error Resume Next
Me.ListBox1.Clear
myStr = UCase(Me.TextBox1.Value)
For i = 1 To Len(myStr)
If Asc(Mid$(myStr, i, 1)) < 0 Then LG = True: Exit For
Next
arr2 = Array("联系人", "录单日期", "单号")
k = k + 1
ReDim arr1(1 To 3, 1 To k)
For i = 1 To 3
arr1(i, k) = arr2(i - 1)
Next
For i = 1 To UBound(arrsj)
s = arrsj(i, 1) & arrsj(i, 2) & arrsj(i, 3)
N = ""
If LG Then
N = s
Else
For j = 1 To Len(s)
P = Mid(s, j, 1)
If Asc(P) < 0 Then N = N & PinYin(P) Else N = N & P
Next
End If
If InStr(N, myStr) Then
k = k + 1
ReDim Preserve arr1(1 To 3, 1 To k)
For t = 1 To 3
arr1(t, k) = arrsj(i, t)
Next
End If
Next i
If t = 0 Then Exit Sub
Me.ListBox1.List = Application.Transpose(arr1)
Me.ListBox1.Selected(1) = True
Set d = Nothing
End Sub
Private Sub UserForm_Initialize()
If ActiveSheet.Name = "撤单" Then
Dim d As Object, arr, i, arrsj()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("数据库").Range("A1:C" & Sheets("数据库").[A65536].End(3).Row)
ReDim arrsj(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr, 1)
s = arr(i, 1) & arr(i, 2) & arr(i, 3)
If Not d.exists(s) Then
d(s) = ""
k = k + 1
arrsj(k, 1) = arr(i, 1)
arrsj(k, 2) = arr(i, 2)
arrsj(k, 3) = arr(i, 3)
End If
Next
End If
Me.ListBox1.List = arrsj
Me.ListBox1.Selected(0) = True
Set d = Nothing
End Sub
|
|