ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 887|回复: 8

[求助] ListBox定宽显示问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-16 10:21 | 显示全部楼层 |阅读模式
如下图:英文点号视觉占位并非一个空格位。为了保证有个完美的行高,我用了微软雅黑字体。

222.jpg
三列数据通过空格补位连接成字符串通过ListBox显示,
不要说用ListView,这个我知道,好用,但复杂难写,针对不同客户机环境经常出问题。
很多时候,简单原始的最好用。

我的补位代码如下:

    Dim Res_Data()
    Res_Data = ThisWorkbook.Sheets("会计科目").UsedRange.Value
    Dim List_Data(), Find_Num As Long
    Dim L1 As Long, L2 As Long
    For I = 3 To UBound(Res_Data)
      If InStr(Res_Data(I, 1), TB_Lookup) > 0 Or InStr(Res_Data(I, 2), TB_Lookup) > 0 Then
        Find_Num = Find_Num + 1
        ReDim Preserve List_Data(1 To Find_Num)
        L1 = Len(Res_Data(I, 1))
        L2 = Len(Res_Data(I, 2))
        List_Data(Find_Num) = Res_Data(I, 1) & String(14 - L1, " ") & Res_Data(I, 2) & String(20 - L2, " ") & Res_Data(I, 3)
      End If
    Next
    If Find_Num = 0 Then
      MsgBox "找不到任何包含关键字的有效数据!" & Chr(13) & Chr(13) & _
             "请尝试减少关键字符数或重新输入。", vbInformation, "乐天工作室:温馨提示!"
      TB_Lookup.SetFocus
    Else
      ListBox1.List = List_Data
    End If

哪位鬼才有没有完美的对齐解决方案?
还望赐教!

TA的精华主题

TA的得分主题

发表于 2020-1-16 11:00 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
当然有变通的方法,只看你喜不喜欢:看你图片有3列数据,你可以每个数据一行显示,3行为一组,还可以在行前加标题,这样就不用管字段长度了,而且美观,我之前做过的但是没找到文件了。

TA的精华主题

TA的得分主题

发表于 2020-1-16 11:04 | 显示全部楼层
为什么要连成字符串用一列显示呢?用三列不好吗?而且附件还不上传。

TA的精华主题

TA的得分主题

发表于 2020-1-16 11:28 | 显示全部楼层
用vbtab连接,不足8字符长度的再增加一个vbtab,写个判断就行。

TA的精华主题

TA的得分主题

发表于 2020-1-16 11:39 | 显示全部楼层
直接用二维数组,同时设置列数
  1. Sub test()
  2.     Dim arr As Variant, lngRow As Long, lngCol As Long
  3.    
  4.    
  5.     arr = Sheet1.Range("D20:F32")
  6.     ListBox1.ColumnCount = UBound(arr, 2) - LBound(arr, 2) + 1
  7.     ListBox1.List = arr
  8.    
  9.    
  10.    
  11.    
  12.     ReDim arr(2 To 8, 10 To 13)
  13.     For lngRow = LBound(arr) To UBound(arr)
  14.         For lngCol = LBound(arr, 2) To UBound(arr, 2)
  15.             arr(lngRow, lngCol) = lngRow & "-" & lngCol
  16.         Next
  17.     Next
  18.     ListBox2.ColumnCount = UBound(arr, 2) - LBound(arr, 2) + 1
  19.     ListBox2.List = arr
  20.    
  21. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2020-1-16 11:39 | 显示全部楼层
供参考 listbox 多列的方法
  1. Dim Res_Data()
  2.     Res_Data = ThisWorkbook.Sheets("会计科目").UsedRange.Value
  3.     Dim List_Data(), Find_Num As Long
  4.     Dim L1 As Long, L2 As Long
  5.     ReDim List_Data(1 To 3, 1 To UBound(Res_Data))
  6.     For I = 3 To UBound(Res_Data)
  7.         If InStr(Res_Data(I, 1), TB_Lookup) > 0 Or InStr(Res_Data(I, 2), TB_Lookup) > 0 Then
  8.             Find_Num = Find_Num + 1
  9.             L1 = Len(Res_Data(I, 1))
  10.             L2 = Len(Res_Data(I, 2))
  11.             List_Data(1, Find_Num) = Res_Data(I, 1)
  12.             List_Data(2, Find_Num) = Res_Data(I, 2)
  13.             List_Data(3, Find_Num) = Res_Data(I, 3)
  14.         End If
  15.     Next
  16.     ReDim Preserve List_Data(1 To 3, 1 To Find_Num)
  17.     If Find_Num = 0 Then
  18.         MsgBox "找不到任何包含关键字的有效数据!" & Chr(13) & Chr(13) & _
  19.             "请尝试减少关键字符数或重新输入。", vbInformation, "乐天工作室:温馨提示!"
  20.         TB_Lookup.SetFocus
  21.     Else
  22.         ListBox1.ColumnCount = 3
  23.         ListBox1.List = Application.WorksheetFunction.Transpose(List_Data)
  24.         ListBox1.ColumnWidths = "100;100;100"
  25.     End If
复制代码


TA的精华主题

TA的得分主题

发表于 2020-1-16 11:45 | 显示全部楼层
本帖最后由 yjh_27 于 2020-1-16 11:52 编辑

小数点引起的,加一句试试
L1 = Len(Res_Data(I, 1))
if  int(Res_Data(I, 1))<>Res_Data(I, 1)  then L1=L1-1     
其实只要找到第2行不齐的原因,解决即可。小数点造成的不齐无需处理。

TA的精华主题

TA的得分主题

发表于 2020-1-16 13:40 | 显示全部楼层
试试

        L1 = Application.Len(Res_Data(I, 1))
        L2 = Application.Len(Res_Data(I, 2))

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-16 17:50 | 显示全部楼层
感谢各位的热心回答!
真的很丢脸啊,居然把多列显示功能给忘得一干二净了。
没错就用这个,已经完美解决。
再次谢谢大家!谢谢!
QQ截图20200116174636.jpg
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 21:36 , Processed in 0.041148 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表