|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
r = ActiveCell.Row
With ListBox1
For i = 1 To .ListCount - 1
If .Selected(i) = True Then
xh = i
Exit For
End If
Next i
If xh <> "" Then
For j = 0 To 2
Cells(r, j + 1) = .List(xh, j)
Next j
End If
End With
End Sub
Private Sub TextBox1_Change()
With Sheets("基础资料汇总")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("b1:h" & r)
End With
lh = ActiveCell.Column
With ListBox1
.Clear
zd = TextBox1.Text
If zd = "" Then
.List = ar
Else
Dim br()
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
n = 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(1, j)
Next j
For i = 2 To UBound(ar)
If InStr(ar(i, lh), zd) > 0 Then
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next j
End If
Next i
If n = 1 Then
.List = ar
Else
.List = br
End If
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim irow As Integer
Application.ScreenUpdating = False
With Sheets("基础资料汇总")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("b1:h" & r)
End With
With ListBox1
.Clear
.ColumnCount = 7
.ColumnWidths = "80,80,80"
.List = ar
End With
Application.ScreenUpdating = True
End Sub
|
|