日常工作事项管理的vba模板
功能介绍：输入/修改/上下翻页/状态筛选/工作表状态区分（条件格式显色突出）Dim l As Integer, arr, brr(0 To 1, 1 To 1000), intrownow, k As Integer, J As Integer, intclick_xz, intclick_xg, mrr
Private Sub UserForm_Initialize()
l = Sheets(3).Range("a65560").End(xlUp).Row
If l = 1 Then MsgBox "暂时没有家庭事项": Exit Sub
时间.Text = Sheets(3).Range("a" & l)
事项.Text = Sheets(3).Range("b" & l)
简述.Text = Sheets(3).Range("c" & l)
交接情况.Text = Sheets(3).Range("d" & l)
完成情况.AddItem Sheets(3).Range("e" & l)
intrownow = l
记录位置.Caption = "记录结果位于" & intrownow
End Sub
Private Sub 上一条_Click()
If 未完成.Value = False Then
intrownow = intrownow - 1
时间.Text = Sheets(3).Range("a" & intrownow)
事项.Text = Sheets(3).Range("b" & intrownow)
简述.Text = Sheets(3).Range("c" & intrownow)
交接情况.Text = Sheets(3).Range("d" & intrownow)
完成情况.RemoveItem all
完成情况.AddItem Sheets(3).Range("e" & intrownow)
记录位置.Caption = "记录结果位于" & intrownow
If intrownow <= 2 Then MsgBox "最上一行记录": Exit Sub
Else
k = k - 1
If k = 0 Then MsgBox "上面没有未完成项目": Exit Sub
时间.Text = Sheets(3).Range("a" & brr(1, k))
事项.Text = Sheets(3).Range("b" & brr(1, k))
简述.Text = Sheets(3).Range("c" & brr(1, k))
交接情况.Text = Sheets(3).Range("d" & brr(1, k))
完成情况.RemoveItem all
完成情况.AddItem Sheets(3).Range("e" & brr(1, k))
intrownow = brr(1, k)
记录位置.Caption = "记录结果位于" & intrownow
End If
End Sub
Private Sub 下一条_Click()
If 未完成.Value = False Then
intrownow = intrownow + 1
时间.Text = Sheets(3).Range("a" & intrownow)
事项.Text = Sheets(3).Range("b" & intrownow)
简述.Text = Sheets(3).Range("c" & intrownow)
交接情况.Text = Sheets(3).Range("d" & intrownow)
完成情况.RemoveItem all
完成情况.AddItem Sheets(3).Range("e" & intrownow)
记录位置.Caption = "记录结果位于" & intrownow
If intrownow > l - 1 Then MsgBox "最下一行记录": Exit Sub
Else
k = k + 1
If k > J Then MsgBox "下面没有未完成项目": Exit Sub
时间.Text = Sheets(3).Range("a" & brr(1, k))
事项.Text = Sheets(3).Range("b" & brr(1, k))
简述.Text = Sheets(3).Range("c" & brr(1, k))
交接情况.Text = Sheets(3).Range("d" & brr(1, k))
完成情况.RemoveItem all
完成情况.AddItem Sheets(3).Range("e" & brr(1, k))
intrownow = brr(1, k)
记录位置.Caption = "记录结果位于" & intrownow
End If
End Sub
Private Sub 未完成_Click()
int_wwc = int_wwc + 1
If int_wwc Mod 2 = 1 Then
未完成.Value = True
arr = Sheets(3).Range("a2:e" & l)
For i = 1 To UBound(arr)
If arr(i, 5) = "未完成" Then
k = k + 1
brr(1, k) = i + 1
End If
Next i
J = k
If k = 0 Then MsgBox "没有未完成事项": 未完成.Value = False: Exit Sub
时间.Text = Sheets(3).Range("a" & brr(1, k))
事项.Text = Sheets(3).Range("b" & brr(1, k))
简述.Text = Sheets(3).Range("c" & brr(1, k))
交接情况.Text = Sheets(3).Range("d" & brr(1, k))
完成情况.RemoveItem all
完成情况.AddItem Sheets(3).Range("e" & brr(1, k))
intrownow = brr(1, k)
记录位置.Caption = "记录结果位于" & intrownow
Else
未完成.Value = False
End If
End Sub
Private Sub 新增_Click()
intclick_xz = intclick_xz + 1
If intclick_xz Mod 2 = 1 Then
新增.Caption = "添加"
时间.Text = Format(Now, "short date")
事项.Text = ""
简述.Text = ""
交接情况.Text = ""
完成情况.RemoveItem all
完成情况.AddItem "完成"
完成情况.AddItem "未完成"
时间.SetFocus
Else
l = l + 1
新增.Caption = "新增"
Sheets(3).Range("a" & l) = 时间.Text
Sheets(3).Range("b" & l) = 事项.Text
Sheets(3).Range("c" & l) = 简述.Text
完成情况.RemoveItem all
Sheets(3).Range("d" & l) = 交接情况.Text
Sheets(3).Range("e" & l) = 完成情况.Text
intrownow = l
Worksheets(3).Rows("1:1000").AutoFit
intrownow = l
记录位置.Caption = "记录结果位于" & intrownow
End If
End Sub
Private Sub 修改_Click()
intclick_xg = intclick_xg + 1
If intclick_xg Mod 2 = 1 Then
修改.Caption = "确认修改"
时间.SetFocus
完成情况.RemoveItem all
完成情况.AddItem "完成"
完成情况.AddItem "未完成"
Else
修改.Caption = "修改"
Sheets(3).Range("a" & intrownow) = 时间.Text
Sheets(3).Range("b" & intrownow) = 事项.Text
Sheets(3).Range("c" & intrownow) = 简述.Text
Sheets(3).Range("d" & intrownow) = 交接情况.Text
Sheets(3).Range("e" & intrownow) = 完成情况.Text
完成情况.Clear
完成情况.AddItem Sheets(3).Range("e" & intrownow)
End If
End Sub
具体关键点：全局变量的/条件筛选的双数组/功能模块的调用/条件格式中参数的调用（嵌套变量） 代码学习下 之前接触过vba 一段时间不用 有些生疏了 35122221~ 好东西，谢谢分享！！！！ 整体的Excel文件可以在发一下，感兴趣的朋友也能测试一下效果，同时提出不同的想法 支持楼上，麻烦发个完整的！ 请朋友完整发一份，谢谢！ 把excel文件也发一份吧
页:
[1]