有没人知道这个日历怎么做的（万年历+工作日志）

盒子里的猫2020

我想请教下，右边详细事项 这个框框内容是怎么提取出来的，我之前按照网上的步骤，前面的已经做好了，就是右边详细事项 这一步怎么弄都无法做出来，请问该怎么做呢，谢谢老师

a364506926

YZC51 发表于 2020-2-21 17:18
没有附件，无法测试

我的详细事项也不能显示，用excel2016添加2020.4.10的详细事件，也不显示

a364506926

YZC51 发表于 2020-2-21 17:18
没有附件，无法测试

我试了试，应该是跨年就不行了，你的源文件是2019年的，在最后加一行2020年的，输入标志和详细事项，切回月历表，调到2020年那天，详细事项不显示

YZC51

您好！日期。如图

YZC51

a364506926 发表于 2020-4-11 00:21
我试了试，应该是跨年就不行了，你的源文件是2019年的，在最后加一行2020年的，输入标志和详细事项，切回 ...

请看回复图片！

YZC51

a364506926 发表于 2020-4-11 00:21
我试了试，应该是跨年就不行了，你的源文件是2019年的，在最后加一行2020年的，输入标志和详细事项，切回 ...

新版本进行了优化
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim dt As Date
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Row + 1 And 1 Then [j4] = "": Exit Sub
    Set Rng = Application.Intersect(Target, [b5:H15])
    If Rng Is Nothing Then Exit Sub
    If Target.Row Mod 2 = 0 Then Exit Sub
    myr = Sheets("记事表").Range("a65536").End(xlUp).Row + 1
    If IsEmpty(arr) Then arr = Sheets("记事表").Range("a2:C" & myr).Value
    Application.EnableEvents = False
    If Len(Target) = 0 Then
        [j4] = Chr(10) & " 暂无数据！"
        ActiveSheet.Unprotect
        Range("J4").Font.Color = -16776961
        ActiveSheet.Protect
    Else
        dt = CDate(Target(0, 1))
        For j = 2 To myr
            If CDate(arr(j, 1)) = dt And arr(j, 2) = Target Then
                [j4] = " " & Replace(arr(j, 3), "、", Chr(10) & " ")
                ActiveSheet.Unprotect
                Range("J4").Font.ColorIndex = xlAutomatic
                ActiveSheet.Protect
                Exit For
            End If
        Next j
    End If
    Application.EnableEvents = True
End Sub

YZC51

计划完成日程表-V2.0
计划完成日程表-V2.0.rar (29.4 KB, 下载次数: 529)

2020-4-11 16:10 上传

点击文件名下载附件

YZC51

盒子里的猫2020 发表于 2020-4-9 16:48
我想请教下，右边详细事项 这个框框内容是怎么提取出来的，我之前按照网上的步骤，前面的已经做好了，就是 ...

您好！是用的工作表事件

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim dt As Date
   
3.     If Target.CountLarge > 1 Then Exit Sub
   
4.     If Target.Row + 1 And 1 Then [j4] = "": Exit Sub
   
5.     Set Rng = Application.Intersect(Target, [b5:H15])
   
6.     If Rng Is Nothing Then Exit Sub
   
7.     If Target.Row Mod 2 = 0 Then Exit Sub
   
8.     myr = Sheets("记事表").Range("a65536").End(xlUp).Row
   
9.     arr = Sheets("记事表").Range("a1:C" & myr).Value
   
10.     Application.EnableEvents = False
    
11.     If Len(Target) = 0 Then
    
12.         [j4] = Chr(10) & " 暂无数据！"
    
13.         ActiveSheet.Unprotect
    
14.         Range("J4").Font.Color = -16776961
    
15.         ActiveSheet.Protect
    
16.     Else
    
17.         dt = CDate(Target(0, 1))
    
18.         For j = 2 To myr
    
19.             If CDate(arr(j, 1)) = dt And arr(j, 2) = Target Then
    
20.                 [j4] = Chr(10) & " " & Replace(arr(j, 3), "、", Chr(10) & " ")
    
21.                 ActiveSheet.Unprotect
    
22.                 Range("J4").Font.ColorIndex = xlAutomatic
    
23.                 ActiveSheet.Protect
    
24.                 Exit For
    
25.             End If
    
26.         Next j
    
27.     End If
    
28.     Application.EnableEvents = True
    
29. End Sub
    

复制代码

盒子里的猫2020

YZC51 发表于 2020-4-11 16:27
您好！是用的工作表事件

谢谢回复，我看下我能不能做出来

YZC51

盒子里的猫2020 发表于 2020-4-12 10:19
谢谢回复，我看下我能不能做出来

您好！老师一定能的！