按要求将考试成绩导入

sxdmsz

taller 发表于 2024-3-18 11:26

老师你好运行时出现子过程或函数未定义，MergeRng，麻烦有空看看，谢谢

chxw68

sxdmsz 发表于 2024-4-7 14:43
老师你好运行时出现子过程或函数未定义，MergeRng，麻烦有空看看，谢谢

是将[上次成绩]表中的所有学生的成绩导入到[1]表中？还是先在[1]表中输入好姓名，然后将对应的成绩导入到[1]表中。

sxdmsz

chxw68 发表于 2024-4-7 16:53
是将[上次成绩]表中的所有学生的成绩导入到[1]表中？还是先在[1]表中输入好姓名，然后将对应的成绩导入 ...

是先在[1]表中输入好姓名，然后将对应的成绩导入到[1]表中。谢谢

taller

sxdmsz 发表于 2024-4-7 14:43
老师你好运行时出现子过程或函数未定义，MergeRng，麻烦有空看看，谢谢

没有示例文件，无法调试

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     Set d1 = CreateObject("scripting.dictionary")
   
9.     Set d2 = CreateObject("scripting.dictionary")
   
10.     Set d3 = CreateObject("scripting.dictionary")
    
11.     Randomize (Timer)
    
12.     With Worksheets("上次成绩")
    
13.         .AutoFilterMode = False
    
14.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.         arr = .Range("a1:p" & r)
    
16.         For i = 2 To UBound(arr)
    
17.             xm = arr(i, 2) & "+" & arr(i, 1)
    
18.             d(xm) = i
    
19.         Next
    
20.         For j = 3 To UBound(arr, 2)
    
21.             d1(arr(1, j)) = j
    
22.         Next
    
23.         r = .Cells(.Rows.Count, 28).End(xlUp).Row
    
24.         crr = .Range("ab1:ab" & r)
    
25.         For i = 2 To UBound(crr)
    
26.             d2(crr(i, 1)) = Empty
    
27.         Next
    
28.     End With
    
29.     With Worksheets("1")
    
30.         .AutoFilterMode = False
    
31.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
32.         .Range("b2:b" & r).Font.ColorIndex = 0
    
33.         .Range("d2:l" & r).ClearContents
    
34.         brr = .Range("a1:m" & r)
    
35.         c = UBound(brr, 2)
    
36.         For j = 7 To UBound(brr, 2) - 1
    
37.             d2(Left(brr(1, j), 1)) = j
    
38.         Next
    
39.         For i = 2 To UBound(brr)
    
40.             xm = brr(i, 3) & "+" & brr(i, 2)
    
41.             If d.exists(xm) Then
    
42.                 m = d(xm)
    
43.                 For j = 4 To 6
    
44.                     If d1.exists(brr(1, j)) Then
    
45.                         n = d1(brr(1, j))
    
46.                         brr(i, j) = arr(m, n)
    
47.                     End If
    
48.                 Next
    
49.                 For k = 1 To Len(brr(i, c))
    
50.                     km = Mid(brr(i, c), k, 1)
    
51.                     If d2.exists(km) Then
    
52.                         j = d2(km)
    
53.                         If d1.exists(brr(1, j)) Then
    
54.                             n = d1(brr(1, j))
    
55.                             brr(i, j) = arr(m, n)
    
56.                         End If
    
57.                     End If
    
58.                 Next
    
59.             End If
    
60.             For j = 4 To 6
    
61.                 If Len(brr(i, j)) = 0 Then
    
62.                     Select Case j
    
63.                         Case 4
    
64.                             brr(i, j) = 60 + Int(Rnd() * 26)
    
65.                         Case 5
    
66.                             brr(i, j) = 20 + Int(Rnd() * 31)
    
67.                         Case 6
    
68.                             brr(i, j) = 40 + Int(Rnd() * 26)
    
69.                     End Select
    
70.                 End If
    
71.             Next
    
72.             For k = 1 To Len(brr(i, c))
    
73.                 km = Mid(brr(i, c), k, 1)
    
74.                 If d2.exists(km) Then
    
75.                     j = d2(km)
    
76.                     If Len(brr(i, j)) = 0 Then
    
77.                         Select Case km
    
78.                             Case "物"
    
79.                                 brr(i, j) = 10 + Int(Rnd() * 21)
    
80.                             Case "历"
    
81.                                 brr(i, j) = 30 + Int(Rnd() * 21)
    
82.                             Case "化"
    
83.                                 brr(i, j) = 10 + Int(Rnd() * 21)
    
84.                             Case "生"
    
85.                                 brr(i, j) = 30 + Int(Rnd() * 16)
    
86.                             Case "政"
    
87.                                 brr(i, j) = 30 + Int(Rnd() * 21)
    
88.                             Case "地"
    
89.                                 brr(i, j) = 30 + Int(Rnd() * 22)
    
90.                         End Select
    
91.                     End If
    
92.                               
    
93.                 End If
    
94.             Next
    
95.             If d2.exists(brr(i, 2)) Then
    
96.                 brr(i, 6) = Empty
    
97.             End If
    
98.         Next
    
99.         .Range("a1:m" & r) = brr
    
100.         For i = 2 To UBound(brr)
     
101.             If Len(brr(i, 6)) = 0 Then
     
102.                 .Cells(i, 2).Font.ColorIndex = 3
     
103.             End If
     
104.         Next
     
105.     End With
     
106. End Sub
     

复制代码

chxw68

练练手。。