全年的培训课程以日历方式显示

wanghq2006

本人刚刚学VBA，领导交代一个任务，自己试了好久，完成不了，所以上来请大侠们帮忙，任务是这样的

wanghq2006

工作薄中有两个工作表，总表存放全年的培训安排，包括培训课程、时间、地点、讲师、培训对象等信息，按月查询表，将全年的培训课程按月显示：

1、将总表中的培训课程以日历方式显示，例：总表中有1月23日有职业规划及办公技能两门培训课程 ，在按月查谒表中的对应日历下体现这两门课程 。

2、希望这个表能智能一些，即按查询数据命令按钮，弹出一个对话框，输入一些查询条件，月份为必输入条件，培训师为可选条件，点击确定后除能够自动显示这个月的日历以外，还能显示对应日期所要开展的培训课程，培训课程 在一个单元格显示，不同培训课程能换行显示。

Book1.rar (120.39 KB, 下载次数: 23)

2013-1-30 15:48 上传

点击文件名下载附件

huguifang

标记一下，，，，，，

李甲

这个用V应该很简单               

zhaogang1960

请测试:

1. Sub 宏1()
   
2.     Dim MyDate As Date, MyYear%, MyMonth%, l%, lastday%
   
3.     Dim arr, brr(), d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     MyYear = [c3]
   
6.     MyMonth = [h3]
   
7.     MyDate = DateSerial(MyYear, MyMonth, 1)
   
8.     [b3] = Application.Text(MyDate, "mmm")
   
9.     f = Weekday(DateSerial(MyYear, MyMonth, 1))
   
10.     lastday = Day(DateSerial(MyYear, MyMonth + 1, 0))
    
11.     ReDim brr(1 To Application.RoundUp((f + lastday - 1) / 7, 0) * 2, 1 To 7)
    
12.     arr = Sheets("总表").[a1].CurrentRegion
    
13.     For i = 3 To UBound(arr)
    
14.         d(arr(i, 3)) = d(arr(i, 3)) & Chr(10) & arr(i, 2)
    
15.     Next
    
16.     n = Weekday(DateSerial(MyYear, MyMonth, 1)) - 1
    
17.     For i = 1 To lastday
    
18.         n = n + 1
    
19.         If n > 7 Then
    
20.             n = 1
    
21.             m = m + 2
    
22.         End If
    
23.         brr(m + 1, n) = DateSerial(MyYear, MyMonth, i)
    
24.         If d.Exists(brr(m + 1, n)) Then brr(m + 2, n) = Mid(d(brr(m + 1, n)), 2)
    
25.     Next
    
26.     Range("B5:H16").ClearContents
    
27.     [b5].Resize(UBound(brr), 7) = brr
    
28. End Sub

复制代码

zhaogang1960

请看附件
Book1.rar (229.9 KB, 下载次数: 37)

2013-1-30 17:11 上传

点击文件名下载附件

emmarosehan

zhaogang1960 发表于 2013-1-30 17:11
请看附件

老师,如果想同时筛选出主训部门呢?

emmarosehan

zhaogang1960 发表于 2013-1-30 17:11
请看附件

我想把B3变为培训部门显示,再做筛选,请老师执教,谢谢

YZC51

学习老师到代码！谢谢老师！
全年的培训课程.rar (140.79 KB, 下载次数: 7)

2018-9-22 09:51 上传

点击文件名下载附件