给单元格添加注释

feilanga

............

奋斗000

feilanga 发表于 2024-5-19 15:24
............

谢谢大神，就是这个意思。有点地方需要修改一下，数字转化成它代表的科目，如1，代表政治，。最终呈现的结果如：监考次数2，必监考科目：政治语文，不监考科目数学地理

feilanga

................

奋斗000

feilanga 发表于 2024-5-19 15:52
................

谢谢大神，经测试有bug，比如李27必监考123，批注还是123，没有转换成对应学科政治语文综合，同理，不监考科目也存在这样的问题。

feilanga

...................

奋斗000

feilanga 发表于 2024-5-19 16:43
...................

非常感谢。完美解决问题

quqiyuan

参与一下

quqiyuan

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Cells.Count = 1 Then
   
3.     If Target.Value <> "" Then
   
4.         Me.UsedRange.ClearComments
   
5.         Dim selectedValue As String
   
6.         selectedValue = Target.Value
   
7.         Set sht = ThisWorkbook.Sheets("基础信息设置")
   
8.         arr = sht.UsedRange
   
9.         r = UBound(arr)
   
10.         rr = sht.Cells(Rows.Count, "h").End(3).Row
    
11.         brr = sht.Range(sht.[h1], sht.Cells(rr, "i"))
    
12.         crr = sht.Range(sht.[c1], sht.Cells(r, "c"))
    
13.         j = Application.Match(selectedValue, crr, 0)
    
14.         If IsError(j) Then Exit Sub
    
15.         If arr(j, 5) <> "" Then
    
16.             For i = 1 To Len(arr(j, 5))
    
17.                 m = Val(Mid(arr(j, 5), i, 1))
    
18.                 s = s & "、" & Application.VLookup(m, brr, 2, 0)
    
19.             Next
    
20.         End If
    
21.         If arr(j, 6) <> "" Then
    
22.             For i = 1 To Len(arr(j, 6))
    
23.                 m = Val(Mid(arr(j, 6), i, 1))
    
24.                 ss = ss & "、" & Application.VLookup(m, brr, 2, 0)
    
25.             Next
    
26.         End If
    
27.         If s <> "" Then s = "必监考科目: " & Right(s, Len(s) - 1) & vbCrLf
    
28.         If ss <> "" Then ss = "不必监考科目: " & Right(ss, Len(ss) - 1)
    
29.         With Target
    
30.             If Not .Comment Is Nothing Then .Comment.Delete
    
31.             .AddComment Text:="监考次数: " & arr(j, 4) & vbCrLf & s & ss
    
32.             .Comment.Visible = True
    
33.         End With
    
34.     End If
    
35.     End If
    
36. End Sub
    

复制代码

feilanga

输出结果加个顿号连接

奋斗000

quqiyuan 发表于 2024-5-19 17:22

结果非常好，能让另一段重复值高亮代码和它共存，同运行吗