动态设置 Listbox 的列数与列宽

VBA万岁

VBA万岁 发表于 2014-4-25 15:24
代码改进如下：
Private Sub TextBox1_Change()
Dim i%, j%, c As Long, s$, arr, brr

以上代能动态显示指定的列，但无法动态指定列宽，即不能保持指定列原来（初始）的列宽。希望有人能够完善一下。

aman1516

VBA万岁 发表于 2014-4-25 16:08
以上代能动态显示指定的列，但无法动态指定列宽，即不能保持指定列原来（初始）的列宽。希望有人能够完善 ...

太谢谢了，正是这样的效果。
对应列宽的问题，我之前看到过一个以数组形式一同设定的方法，但实翻不出来了例子，似乎为建立基准字段与列宽数组：
{"序号",40;"物料类别",60;"物料编码",70;"物料名称",150;"材质",50;"规格型号",80;"颜色',50},
然后再对对应的 listbox 列进行判定及设置的。
再次感谢 ＶＢＡ万岁 ，我也研究一下，最好能完美解决。

VBA万岁

aman1516 发表于 2014-4-25 16:58
太谢谢了，正是这样的效果。
对应列宽的问题，我之前看到过一个以数组形式一同设定的方法，但实翻不出来 ...

我知道怎么解决了。
明天之前再上传附件。

aman1516

还有一个问题，10楼的代码只是建立了筛选列之后的数据，而 listbox 的列数仍是窗体建立时设定的初始化列数，而不是动态根据指定实际列数生成的，因此，当Textbox指定的列数比原始设定的列数大时（此例中数据源大于7列，并Textbox 中大于7个字段时，或将 ListBox1.ColumnCount = 7 改为２或３时——小于Textbox 指定列数时），数据就会缺失……
因此，思路应该是，listbox的参数与设置是在得出数据结果之后重新建立，同样应放在 Textbox 事件中去

aman1516

改了一下：


Private Sub TextBox1_Change()
Dim i%, j%, c As Long, s$, arr, brr
For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
    If InStr(TextBox1.Text, Cells(1, i).Value) > 0 Then s = s & ":" & i
Next i
If s <> "" Then
    s = Right(s, Len(s) - 1)
Else
    For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
        If InStr(Cells(1, i).Value, TextBox1.Text) > 0 Then s = i: Exit For
    Next i
End If
arr = Split(s, ":")
nCol = [A65536].End(xlUp).Row
ReDim brr(1 To nCol, 1 To UBound(arr) + 1)
For i = 1 To nCol
    For j = 1 To UBound(arr) + 1
       brr(i, j) = Cells(i, Val(arr(j - 1))).Value
    Next j
Next i

With Me.ListBox1
     .Clear
     .ColumnCount = UBound(brr)
     .ColumnWidths = "40,60,70,150,50,80,50"      '如何针对 brr 字段设置列宽？
     .ListIndex = -1
     .List = brr
End With
End Sub

去掉 UserForm_Initialize() 代码

aman1516

再修改一下：

Private Sub TextBox1_Change()
Dim i%, j%, c As Long, s$, arr, brr
For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
     If InStr(TextBox1.Text, Cells(1, i).Value) > 0 Then s = s & ":" & i
Next i
If s <> "" Then
     s = Right(s, Len(s) - 1)
Else
     For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
         If InStr(Cells(1, i).Value, TextBox1.Text) > 0 Then s = i: Exit For
     Next i
End If
arr = Split(s, ":")
nCol = [A65536].End(xlUp).Row
ReDim brr(1 To nCol, 1 To UBound(arr) + 1)
For i = 1 To nCol
     For j = 1 To UBound(arr) + 1
        brr(i, j) = Cells(i, Val(arr(j - 1))).Value
     Next j
Next i

Dim crr
Dim cc, m, n
crr = [{"序号",40;"物料类别",60;"物料编码",70;"物料名称",150;"材质",50;"规格型号",80;"颜色",50}]      '预定义各列的宽度
For m = 1 To UBound(brr, 2)
    For n = 1 To UBound(crr)
        If brr(1, m) = crr(n, 1) Then
           cc = cc & crr(n, 2) & ","
        End If
    Next
Next
With Me.ListBox1
      .Clear
      .ColumnCount = UBound(brr)
      .ColumnWidths = Left(cc, Len(cc) - 1)
      .ListIndex = -1
      .List = brr
End With
End Sub

aman1516

基本OK，期望高手优化下代码。

见附件：    如何按指定列设置Listbox列数与列宽，并读入内容.rar (22 KB, 下载次数: 75)

2014-4-25 19:45 上传

点击文件名下载附件

VBA万岁

aman1516 发表于 2014-4-25 19:45
基本OK，期望高手优化下代码。

见附件：

再提供一种方法：

Dim wrr

Private Sub TextBox1_Change()
Dim i%, j%, c As Long, s$, w$, arr, brr
If TextBox1.Text = "" Then ListBox1.Clear: Exit Sub
For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
    If InStr(TextBox1.Text, Cells(1, i).Value) > 0 Then
        s = s & ":" & i
        w = w & Val(wrr(i - 1)) & ";"
    End If
Next i
If s <> "" Then
    s = Right(s, Len(s) - 1)
Else
    For i = 1 To Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 1
        If InStr(Cells(1, i).Value, TextBox1.Text) > 0 Then s = i: w = Val(wrr(i - 1)): Exit For
    Next i
End If
arr = Split(s, ":")
ReDim brr(1 To ListBox1.ListCount, 1 To UBound(arr) + 1)
For i = 1 To ListBox1.ListCount
    For j = 1 To UBound(arr) + 1
       brr(i, j) = Cells(i, Val(arr(j - 1))).Value
    Next j
Next i
With Me.ListBox1
    .ColumnWidths = w
    .List = brr
End With
End Sub

Private Sub UserForm_Initialize()
Dim arr, w$
arr = ActiveSheet.UsedRange
w = "40; 60; 70; 150; 50; 80; 50"
wrr = Split(w, ";")
With Me.ListBox1
    .Clear
    .ColumnCount = 7
    .ColumnWidths = w
    .ListIndex = -1
    .List = arr
End With
End Sub

VBA万岁

VBA万岁 发表于 2014-4-25 20:11
再提供一种方法：

Dim wrr

附件：
指定Listbox列数与列宽并读入内容.zip (33.3 KB, 下载次数: 79)

2014-4-25 20:13 上传

点击文件名下载附件

aman1516

VBA万岁 发表于 2014-4-25 20:13
附件：

列宽设置没问题，但动态设置列似乎未OK