把不同类型的多条日常工作按日历式显示

xg1658

条件：已经自动生成2023年各个月份对应的日历式；日常工作分类、日期和摘要已经准备妥当。
求助：在“日历"工作表的Ｌ３选择类型后，把“数据”工作表上的日常工作按对应的日期、匹配工作类型后的摘要正确显示在每天的日期方块上；注意某天的某个类型数据不止一条时也要适应。
谢谢大佬们指导

gwjkkkkk

Sub TEST1()
    Dim Rng As Range, rngFind As Range, strFirstAddress$
    Dim ar, i&, dic As Object, vKey
   
    Set dic = CreateObject("Scripting.Dictionary")
    ar = Sheets(2).[A1].CurrentRegion
    For i = 2 To UBound(ar)
       If ar(i, 2) <> "" Then
          vKey = ar(i, 2)
          If dic.exists(vKey) Then
              dic(vKey) = dic(vKey) & vbLf & ar(i, 3) & ":" & ar(i, 4)
          Else
              dic(vKey) = ar(i, 3) & ":" & ar(i, 4)
          End If
       End If
    Next i
    Set Rng = [A2:G13]
        For Each vKey In dic.keys
            Set rngFind = Rng.Find(vKey, , , xlWhole)
            If Not rngFind Is Nothing Then
               rngFind.Offset(1) = dic(vKey)
            End If
        Next
    Set Rng = Nothing: Set rngFind = Nothing
   
    Beep
End Sub

gwjkkkkk

请楼主参考附件。。。

xg1658

十分感谢

xg1658

gwjkkkkk 发表于 2023-1-23 11:39
请楼主参考附件。。。

首先感谢回复和指点！其次还想请教一下，目前是把所有的类型一次性显示完毕了，我想按四种不同的类型分开展示，可以吗？比如人员去向，将数据工作表中人员去向显示在查询表上的对就日期。再次感谢　

gwjkkkkk

改了条件，在Worksheet_Change事件也要更改相关内容
If Application.Intersect(Target, [I3:L3]) Is Nothing Then Exit Sub
红字部分为更改内容
请参考附件。。。

xg1658

gwjkkkkk 发表于 2023-1-23 22:23
改了条件，在Worksheet_Change事件也要更改相关内容
If Application.Intersect(Target, ) Is Nothing Then ...

谢谢！！！