|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Dim my()
Dim arrRow() As Long
Private Sub CommandButton5_Click()
Call SetListBox
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim cs As Long
rtnRow = 0
cs = ListBox1.ListIndex
If cs <= 0 Then Exit Sub
rtnRow = arrRow(ListBox1.ListIndex)
Unload Me
End Sub
Private Sub UserForm_Initialize()
Call SetListBox
End Sub
Sub SetListBox()
Dim wIdx As Long
Dim endrow As Long
Dim temp()
Dim i As Long, j As Long
Erase my
Erase arrRow
ListBox1.Clear
Select Case commTableName
Case "单位"
w = ""
With ListBox1
.ColumnCount = 4 '设置列数
For j = 1 To 4
w = w & Sheet6.Cells(1, j).Width & ";"
Next
w = Left(w, Len(w) - 1)
.ColumnWidths = w
.ColumnHeads = False '是否显示列标题
a = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
If a < 2 Then a = 2
ReDim Preserve my(1 To 4, 1 To 1)
my(1, 1) = Sheet6.Range("A1")
my(2, 1) = Sheet6.Range("K1") '
my(3, 1) = Sheet6.Range("L1")
my(4, 1) = Sheet6.Range("J1")
b = 1
For i = 2 To a
For j = 1 To 4
If Sheet6.Cells(i, j) Like "*" & Me.TextBox1.Text & "*" Then
b = b + 1
ReDim Preserve my(1 To 4, 1 To b)
my(1, b) = Sheet6.Range("A" & i)
my(2, b) = Sheet6.Range("K" & i)
my(3, b) = Sheet6.Range("L" & i)
my(4, b) = Sheet6.Range("J" & i)
wIdx = wIdx + 1
ReDim Preserve arrRow(1 To wIdx)
arrRow(wIdx) = i
Exit For
End If
Next
Next
ReDim temp(1 To b, 1 To 4)
For i = 1 To b
For j = 1 To 4
temp(i, j) = my(j, i)
Next
Next
ListBox1.List() = temp
End With
End Select
End Sub
|
|