038-窗体中罗列冠军名单-疑难千寻千解丛书（VBA）

小妖 · 发表于 2011-2-22 12:55

ET疑难千寻千解丛书之EXCEL2010编程与实践

罗刚君章兰新黄朝阳编著

疑难38
在窗体中罗列每月产量冠军名单

好图所示包含了多个月的生产数据。如何实现查找每月的产量冠军并同时显示在窗体列表中呢？

è解决方案

创建一个窗体，在窗体中添加一个列表框。利用公式“=MATCH(MAX(D2:D21), D2:D21,)”获取每个工作表中生产冠军的所有信息，然后配合For...Next循环找出每个月的生产冠军，并导入到数组中。最后将数组一次性赋值给窗体中列表框的List属性。

í操作方法

步骤1
按【Alt+F11】组合键打开VBE窗口。

步骤2
选择菜单“插入”→“用户窗体”，并在属性窗口中将窗体的“Caption”属性修改为“每月产量冠军”；将工具箱中的列表框拖到窗体中，且调整窗体和列表框的大小，使其与图一致。

步骤3
双击窗体进入窗体代码窗口，将自动产生的代码清除，然后重新输入以下代码：

[align=left][size=2][font=Times New Roman]Private Sub UserForm_Activate()
'[/font][font=宋体]激活窗体时执行[/font][/size][/align][align=left][size=2][font=Times New Roman]
Dim sht As Worksheet, arr(), i As Integer, MaxRow As Integer, EndRow As Integer[/font][/size][/align][align=left][size=2][font=Times New Roman]
Me.ListBox1.ListStyle = fmListStyleOption
'[/font][font=宋体]指定列表框的显示外观[/font][/size][/align][align=left][size=2][font=Times New Roman]
Me.ListBox1.ColumnCount = 5
'[/font][font=宋体]列表框显示[/font][font=Times New Roman]5[/font][font=宋体]列[/font][/size][/align][align=left][size=2][font=Times New Roman]
Me.ListBox1.ColumnWidths = "40,40,40,40,40"
'[/font][font=宋体]每列的宽度为[/font][font=Times New Roman]40[/font][/size][/align][align=left][size=2][font=Times New Roman]
i = 1[/font][/size][/align][align=left][size=2][font=Times New Roman]
ReDim Preserve arr(1 To 5, 1 To i)
'[/font][font=宋体]重新分配数组的存储空间[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(1, i) = "[/font][font=宋体]月份[/font][font=Times New Roman]"
'[/font][font=宋体]指定列表框的标题[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(2, i) = "[/font][font=宋体]姓名[/font][font=Times New Roman]"[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(3, i) = "[/font][font=宋体]机台[/font][font=Times New Roman]"[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(4, i) = "[/font][font=宋体]组别[/font][font=Times New Roman]"[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(5, i) = "[/font][font=宋体]产量[/font][font=Times New Roman]"[/font][/size][/align][align=left][size=2][font=Times New Roman]
For Each sht In Sheets
'[/font][font=宋体]遍历所有工作表[/font][/size][/align][align=left][size=2][font=Times New Roman]
i = i + 1
'[/font][font=宋体]累加变量[/font][/size][/align][align=left][size=2][font=Times New Roman]
EndRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
'[/font][font=宋体]找到工作表的最后非空行行号[/font][/size][/align][align=left][size=2][font=Times New Roman]
'[/font][font=宋体]利用公式计算每个工作表中[/font][font=Times New Roman]D[/font][font=宋体]列最大值所在的行号[/font][/size][/align][align=left][size=2][font=Times New Roman]
MaxRow = Evaluate("=MATCH(MAX(" & sht.Name & "!D2:D" & EndRow & ")," & sht.Name & "!D2:D" & EndRow & ",)") + 1[/font][/size][/align][align=left][size=2][font=Times New Roman]
ReDim Preserve arr(1 To 5, 1 To i)[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(1, i) = sht.Name
'[/font][font=宋体]数组[/font][font=Times New Roman]1[/font][font=宋体]行[/font][font=Times New Roman]i[/font][font=宋体]列写入工作表名[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(2, i) = sht.Cells(MaxRow, 1) '2[/font][font=宋体]行[/font][font=Times New Roman]i[/font][font=宋体]列写入姓名[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(3, i) = sht.Cells(MaxRow, 2) '3[/font][font=宋体]行[/font][font=Times New Roman]i[/font][font=宋体]列写入机台[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(4, i) = sht.Cells(MaxRow, 3) '4[/font][font=宋体]行[/font][font=Times New Roman]i[/font][font=宋体]列写入组别[/font][/size][/align][align=left][size=2][font=Times New Roman]
arr(5, i) = sht.Cells(MaxRow, 4) '5[/font][font=宋体]行[/font][font=Times New Roman]i[/font][font=宋体]列写入产量[/font][/size][/align][align=left][size=2][font=Times New Roman]
Next[/font][/size][/align][align=left][size=2][font=Times New Roman]
Me.ListBox1.List = WorksheetFunction.Transpose(arr)
'[/font][font=宋体]将数组倒置后写入列表框[/font][/size][/align][align=left][font=Times New Roman][size=2]End Sub[/size][/font][/align]

复制代码

步骤4
选择菜单“插入”→“模块”，并在模块中输入以下代码：

Sub 多表查找()
UserForm1.Show 0
End Sub

复制代码

步骤5
执行过程“多表查找”，将会弹出如图所示的窗体，罗列出每月的产量冠军。

=============================

以上摘自《EXCEL2010编程与实践》

UNA123 · 发表于 2011-4-9 20:59

{:011:}{:011:}{:011:}{:011:}

fulljy · 发表于 2011-8-28 12:55

学习了，谢谢!

		自动登录	找回密码
密码			注册

[VBA] 038-窗体中罗列冠军名单-疑难千寻千解丛书（VBA）

本帖子中包含更多资源