求助分数段里面的单元格提取学生的姓名写进备注里

excel玉米

458863601 发表于 2024-5-30 14:44
为什么只有中心1有备注姓名，其他班级的没有呢？

excel玉米

已修改成上面代码的附件已上传

458863601

excel玉米 发表于 2024-5-30 15:09

可以直接发代码吗？图片的要写好久，谢谢

458863601

excel玉米 发表于 2024-5-30 15:11
已修改成上面代码的附件已上传

当a列科目合并时，为什么只有中心1班是有备注学生姓名和分数的，中心2，中心3没有，如果我数据变多了十几个班呢？

ykcbf1100

458863601 发表于 2024-5-30 13:51
没有提取学生的姓名和分数写进备注呢？

不是写了，是批注，不是备注。

你把鼠标放到单元格上就出现了。

458863601

ykcbf1100 发表于 2024-5-30 15:42
不是写了，是批注，不是备注。

你把鼠标放到单元格上就出现了。

谢谢， 知道了。

excel玉米

458863601 发表于 2024-5-30 15:28
当a列科目合并时，为什么只有中心1班是有备注学生姓名和分数的，中心2，中心3没有，如果我数据变多了十几 ...

1. '以下面代码为准！！！

复制代码

excel玉米

1. 以此份代码为准，当初没有考虑到合并单元格的情形
   
2. Sub KeyIn_Maket()
   
3. Dim arr, i%, j%, brr, arr_data, arr_list$, Mrow%, Mcol%
   
4. Dim dic As Object
   
5. Set dic = CreateObject("scripting.dictionary")
   
6. Application.ScreenUpdating = False
   
7. arr_data = Sheets("得分").UsedRange
   
8. For i = 2 To UBound(arr_data)
   
9. For j = 3 To 6
   
10.   Key = arr_data(1, j) & arr_data(i, 2) & hd(arr_data(i, j))
    
11.   If Not dic.exists(Key) Then
    
12.      dic(Key) = arr_data(i, 17) & " " & arr_data(i, j)
    
13.   Else
    
14.      arr_list = dic(Key)
    
15.      dic(Key) = arr_list & "|" & arr_data(i, 17) & " " & arr_data(i, j)
    
16.      arr_list = ""
    
17.   End If
    
18. Next j
    
19. Next i
    
20. With Sheets("汇总")
    
21. arr = .Cells(1.1).CurrentRegion
    
22. For i = 3 To UBound(arr) Step 3
    
23.    arr(i + 1, 1) = arr(i, 1)
    
24.    arr(i + 2, 1) = arr(i, 1)
    
25. Next i
    
26. For i = 3 To UBound(arr)
    
27.   For j = 3 To UBound(arr, 2)
    
28.      If Len(.Cells(i, j).Value) > 0 Then
    
29.         Key = arr(i, 1) & arr(i, 2) & j
    
30.         If Not .Cells(i, j).Comment Is Nothing Then .Cells(i, j).Comment.Delete
    
31.         arr_list = dic(Key)
    
32.         .Cells(i, j).AddComment Replace(arr_list, "|", vbCrLf)
    
33.          With .Cells(i, j).Comment.Shape.TextFrame
    
34.               .Characters.Font.Bold = True
    
35.               .Characters.Font.Name = "Arial"
    
36.               .Characters.Font.Size = 12
    
37.               .AutoSize = True
    
38.          End With
    
39.      End If
    
40.   Next j
    
41. Next i
    
42. End With
    
43. Application.ScreenUpdating = True
    
44. End Sub
    

复制代码

458863601

ykcbf1100 发表于 2024-5-30 15:42
不是写了，是批注，不是备注。

你把鼠标放到单元格上就出现了。

看到了，谢谢你