督办事项表功能求助

LeMUsee

各位巨巨好，本人是个EXCEL菜鸟，最近才发现OFFICE系列这么强大。。。小弟这几天想要设计一个督办事项功能列表，分表给到各部门填写，填写完收回来到同一文件夹后，总表统计汇总数据，但是有些功能不知道如何实现，请各位路过大大不吝赐教：



分表：
1、分表设有“起始日”与“截止日”两列数据，能否让剩余天数只剩3天以下的那行高亮显示？（改变底色）
2、每行高度用适合行高显得太密，能否实现一键调成比较美观的行高？（文字有一排也有多排的）


总表：
1、按条件查询各部门督办事项，设有“部门”（对应到每个分表）、“状态”（对应分表F列，分表中是“完成、未完成、超时完成”三项的下拉框）这两个下拉框来按条件查询督办事项，将符合条件的事项在下面整行显示出来。

LeMUsee

自己做了一下，还是很多地方不会。。。做了一份示意表请各位帮忙看看，谢谢！
m(_  _)m

sunya_0529

LeMUsee 发表于 2014-9-15 06:37
自己做了一下，还是很多地方不会。。。做了一份示意表请各位帮忙看看，谢谢！
m(_  _)m

里面有不少需求是用基础操作或者函数无法解决的，用VBA是个不错的选择。

根据你的需求，大概模拟了数据录入的过程，完成了数据的录入、验证和保存，如下图所示——


VBA其实没有想象中的那么复杂，了解基本的语法和对象的各种属性、方法，很容易就能驾驭她。下面是用到的代码，都加了注释，可以根据自己的需要修改。

1. Option Explicit
   
2. 
   
3. Private Sub CommandButton1_Click() '保存数据
   
4. Dim intRow%, rng As Range
   
5. For Each rng In Union([C2], [C4], [C6], [C8], [C10], [C12]) '数据填写验证，不填全不能提交保存
   
6.   If Len(rng.Value) = 0 Then
   
7.     rng.Select
   
8.     MsgBox "[" & rng.Address & "] 里没有填写内容，请补充！"
   
9.     Exit Sub
   
10.   End If
    
11. Next
    
12. With Sheets("数据")
    
13.   intRow = .[A65536].End(xlUp).Row '获取最后一条记录所在行号
    
14.   .Cells(intRow + 1, 1) = Format(Now, "yyyymmddHHMMSS") '流水号
    
15.   .Cells(intRow + 1, 2) = [C2] '部门
    
16.   .Cells(intRow + 1, 3) = CDate([C4]) '起始日
    
17.   .Cells(intRow + 1, 4) = CDate([C6]) '截止日
    
18.   .Cells(intRow + 1, 5).FormulaR1C1 = "＝IF(TODAY()>=RC[-1],0,RC[-1]-RC[-2])" '剩余天数
    
19.   .Cells(intRow + 1, 6) = [C8] '内容
    
20.   .Cells(intRow + 1, 7) = [C10] '负责人
    
21.   .Cells(intRow + 1, 8) = [C12] '状态
    
22.   .Cells(intRow + 1, 9) = [C14] '参与部门
    
23. End With
    
24. MsgBox "数据保存成功！"
    
25. End Sub
    
26. 
    
27. Private Sub CommandButton2_Click() '清空重填
    
28. Union([C2], [C4], [C6], [C8], [C10], [C12], [C14]).ClearContents
    
29. End Sub
    
30. 
    
31. Private Sub ListBox1_Change() '将列表框中选中的内容同步到[C14]中
    
32. Dim str$, i%
    
33. For i = 0 To ListBox1.ListCount - 1
    
34.   If ListBox1.Selected(i) = True Then
    
35.     str = str & "," & ListBox1.List(i)
    
36.   End If
    
37. Next
    
38. If str = "," Then
    
39.   str = ""
    
40. Else
    
41.   str = Right(str, Len(str) - 1)
    
42. End If
    
43. [C14] = str
    
44. End Sub
    
45. 
    
46. Private Sub Worksheet_Activate()
    
47. ListBox1.ListFillRange = Range("bumeng").Address '初始化列表框
    
48. End Sub
    
49. 
    
50. Private Sub Worksheet_Change(ByVal Target As Range)
    
51. Application.EnableEvents = False
    
52. If Target.Address = "$C$4" Then '起始日期检验并识别快速输入mmdd格式
    
53.   If IsDate([C4]) Then
    
54.     If [C4] <= "2000-1-1" Then
    
55.       [C4] = DateSerial(Year(Date), Int([C4] / 100), [C4] - Int([C4] / 100) * 100)
    
56.     End If
    
57.   Else
    
58.     MsgBox "输入的日期数据不能识别，请重新输入！", vbCritical
    
59.     [C4] = ""
    
60.   End If
    
61. End If
    
62. If Target.Address = "$C$6" Then '截止日期检验并识别快速输入mmdd格式
    
63.   If IsDate([C6]) Then
    
64.     If [C6] <= "2000-1-1" Then
    
65.       [C6] = DateSerial(Year(Date), Int([C6] / 100), [C6] - Int([C6] / 100) * 100)
    
66.     End If
    
67.   Else
    
68.     MsgBox "输入的日期数据不能识别，请重新输入！", vbCritical
    
69.     [C6] = ""
    
70.   End If
    
71.   If CDate([C6]) < CDate([C4]) Then
    
72.     MsgBox "截止日期不能晚于开始日期，请重新输入！", vbCritical
    
73.     [C6] = ""
    
74.   End If
    
75. End If
    
76. Application.EnableEvents = True
    
77. End Sub
    
78. 
    
79. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
80. On Error Resume Next
    
81. Dim arrTemp, i%, j%
    
82. If Target.Cells.Count > 1 Then Exit Sub
    
83. 
    
84. With ListBox1
    
85.     If Target.Address = "$C$14" Then '选中[C14]时显示列表框
    
86.     arrTemp = Split([C14], ",")
    
87.     For i = 0 To UBound(arrTemp) '将[C14]中的内容同步到列表框中
    
88.       For j = 0 To .ListCount - 1
    
89.         If .List(i) = arrTemp(i) Then .Selected(i) = True
    
90.       Next j
    
91.     Next i
    
92.     .Visible = True
    
93.   Else
    
94.     .Visible = False
    
95.   End If
    
96. End With
    
97. End Sub
    

复制代码

关于查询的功能，可以用透视表做，如果不会的话，先补充一些测试数据上来，再做一下给你。

具体效果见附件了，打开文件时要启用宏。
督办事项.rar (28.35 KB, 下载次数: 170)

2014-9-18 10:14 上传

点击文件名下载附件

LeMUsee

sunya_0529 发表于 2014-9-18 10:14
里面有不少需求是用基础操作或者函数无法解决的，用VBA是个不错的选择。

根据你的需求，大概模拟了数据 ...

谢谢！前段时间一直在看基础教学书，忘了看回复了。。

LeMUsee

sunya_0529 发表于 2014-9-18 10:14
里面有不少需求是用基础操作或者函数无法解决的，用VBA是个不错的选择。

根据你的需求，大概模拟了数据 ...

稍微看了一下，膜拜大神！m(_ _)m
数据透视表我会做，我要回去好好学习一下巨巨的表格