督办事项表功能求助

LeMUsee · 发表于 2014-9-15 00:22

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

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

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

LeMUsee · 发表于 2014-9-15 06:37

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

sunya_0529 · 发表于 2014-9-18 10:14

本帖最后由 sunya_0529 于 2014-9-18 10:15 编辑

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

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

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

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

Option Explicit
Private Sub CommandButton1_Click() '保存数据
Dim intRow%, rng As Range
For Each rng In Union([C2], [C4], [C6], [C8], [C10], [C12]) '数据填写验证，不填全不能提交保存
If Len(rng.Value) = 0 Then
rng.Select
MsgBox "[" & rng.Address & "] 里没有填写内容，请补充！"
Exit Sub
End If
Next
With Sheets("数据")
intRow = .[A65536].End(xlUp).Row '获取最后一条记录所在行号
.Cells(intRow + 1, 1) = Format(Now, "yyyymmddHHMMSS") '流水号
.Cells(intRow + 1, 2) = [C2] '部门
.Cells(intRow + 1, 3) = CDate([C4]) '起始日
.Cells(intRow + 1, 4) = CDate([C6]) '截止日
.Cells(intRow + 1, 5).FormulaR1C1 = "＝IF(TODAY()>=RC[-1],0,RC[-1]-RC[-2])" '剩余天数
.Cells(intRow + 1, 6) = [C8] '内容
.Cells(intRow + 1, 7) = [C10] '负责人
.Cells(intRow + 1, 8) = [C12] '状态
.Cells(intRow + 1, 9) = [C14] '参与部门
End With
MsgBox "数据保存成功！"
End Sub
Private Sub CommandButton2_Click() '清空重填
Union([C2], [C4], [C6], [C8], [C10], [C12], [C14]).ClearContents
End Sub
Private Sub ListBox1_Change() '将列表框中选中的内容同步到[C14]中
Dim str$, i%
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
str = str & "," & ListBox1.List(i)
End If
Next
If str = "," Then
str = ""
Else
str = Right(str, Len(str) - 1)
End If
[C14] = str
End Sub
Private Sub Worksheet_Activate()
ListBox1.ListFillRange = Range("bumeng").Address '初始化列表框
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$C$4" Then '起始日期检验并识别快速输入mmdd格式
If IsDate([C4]) Then
If [C4] <= "2000-1-1" Then
[C4] = DateSerial(Year(Date), Int([C4] / 100), [C4] - Int([C4] / 100) * 100)
End If
Else
MsgBox "输入的日期数据不能识别，请重新输入！", vbCritical
[C4] = ""
End If
End If
If Target.Address = "$C$6" Then '截止日期检验并识别快速输入mmdd格式
If IsDate([C6]) Then
If [C6] <= "2000-1-1" Then
[C6] = DateSerial(Year(Date), Int([C6] / 100), [C6] - Int([C6] / 100) * 100)
End If
Else
MsgBox "输入的日期数据不能识别，请重新输入！", vbCritical
[C6] = ""
End If
If CDate([C6]) < CDate([C4]) Then
MsgBox "截止日期不能晚于开始日期，请重新输入！", vbCritical
[C6] = ""
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim arrTemp, i%, j%
If Target.Cells.Count > 1 Then Exit Sub
With ListBox1
If Target.Address = "$C$14" Then '选中[C14]时显示列表框
arrTemp = Split([C14], ",")
For i = 0 To UBound(arrTemp) '将[C14]中的内容同步到列表框中
For j = 0 To .ListCount - 1
If .List(i) = arrTemp(i) Then .Selected(i) = True
Next j
Next i
.Visible = True
Else
.Visible = False
End If
End With
End Sub

复制代码

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

具体效果见附件了，打开文件时要启用宏。

督办事项.rar (28.35 KB, 下载次数: 170)

LeMUsee · 发表于 2014-12-1 22:17

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

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

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

LeMUsee · 发表于 2014-12-1 22:35

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

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

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

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

[求助] 督办事项表功能求助