|
楼主 |
发表于 2017-10-31 11:40
|
显示全部楼层
改用 Listview控件 列表
- Private Sub UserForm_Initialize()
- Me.Caption = "欢迎使用【信息管理系统】!" & Space(80) & "今天是 " & Format(Now, "yyyy年m月d日 aaa")
- Dim w&, i&, d As Object
- Set d = CreateObject("Scripting.Dictionary")
- Rem 生成列表,同时将分类写入字典
- With ListView1
- w = Int((.Width - 60) / 4)
- .ColumnHeaders.Add , , "分类", w + 45
- .ColumnHeaders.Add , , "永久", w
- .ColumnHeaders.Add , , "长期", w
- .ColumnHeaders.Add , , "短期", w
- Set .SmallIcons = ImageList1
- End With
- For i = 2 To Sheet4.Range("B65536").End(3).Row
- d(Sheet4.Range("B" & i).Value) = i - 1
- ListView1.ListItems.Add , , Sheet4.Range("B" & i)
- Next
- Rem 对“数据”表按分类和保管期限汇总
- Dim arr, x%, y%
- arr = Sheet1.Range("A1").CurrentRegion
- ReDim a(1 To d.Count, 1 To 3)
- On Error Resume Next
- For i = 2 To UBound(arr)
- 'x = IIf(arr(i, 3) = "永久", 1, IIf(arr(i, 3) = "长期", 2, 3)) 'iif 函数
- x = Switch(arr(i, 3) = "永久", 1, arr(i, 3) = "长期", 2, arr(i, 3) = "短期", 3) '或 Swisse(开关)函数
- y = d.Item(arr(i, 1))
- a(y, x) = a(y, x) + 1
- Next
- Rem 写入统计列表
- Dim Item As MSComctlLib.ListItem
- For i = 1 To d.Count
- Set Item = ListView1.ListItems(i)
- Item.SubItems(1) = a(i, 1)
- Item.SubItems(2) = a(i, 2)
- Item.SubItems(3) = a(i, 3)
- Next
- End Sub
复制代码
|
|