按要求将考试成绩导入

sxdmsz

按要求将考试成绩导入，具体要求见附件。求助老师，谢谢 2.rar (24.71 KB, 下载次数: 24)

2024-3-16 19:50 上传

点击文件名下载附件

yynrzwh

有点麻烦
2.zip (34.39 KB, 下载次数: 22)

2024-3-16 22:34 上传

点击文件名下载附件

582766

好复杂，没有看懂什么意思

taller

1. Option Explicit
   
2. Sub Demo()
   
3.     Dim oDicCJ, oDicJP, oDicNL, rngData2 As Range
   
4.     Dim i As Long, j As Long, k As Long, sKey As String
   
5.     Dim arrData, arrData2, arrData3, aMin, aMax, aIdx
   
6.     Dim oSht1 As Worksheet, oSht2 As Worksheet
   
7.     Const COLCNT = 13
   
8.     Const SUBJECT = "语数英物历化生政地"
   
9.     aMin = Split("60 20 40 10 30 10 30 30 30")
   
10.     aMax = Split("85 50 65 30 50 30 45 50 51")
    
11.     aIdx = Split("3 4 5 6 13 7 9 11 14")
    
12.     Set oSht1 = ThisWorkbook.Sheets("1")
    
13.     Set oSht2 = ThisWorkbook.Sheets("上次成绩")
    
14.     Set oDicCJ = CreateObject("scripting.dictionary")
    
15.     Set oDicJP = CreateObject("scripting.dictionary")
    
16.     Set oDicNL = CreateObject("scripting.dictionary")
    
17.     ' testing ============
    
18.     '    oSht1.Range("C2:M7").ClearContents
    
19.     '    oSht1.Range("C2:M7").Interior.Color = xlNone
    
20.     '============
    
21.     arrData3 = oSht2.Range("V1").CurrentRegion.Value
    
22.     For i = LBound(arrData3) + 1 To UBound(arrData3)
    
23.         oDicNL(arrData3(i, 1)) = i
    
24.     Next i
    
25.     arrData2 = oSht2.Range("AB1").CurrentRegion.Value
    
26.     For i = LBound(arrData2) + 1 To UBound(arrData2)
    
27.         oDicCJ(arrData2(i, 1)) = ""
    
28.     Next i
    
29.     Set rngData2 = oSht2.Range("A1").CurrentRegion
    
30.     arrData2 = rngData2.Value
    
31.     For i = LBound(arrData2) + 1 To UBound(arrData2)
    
32.         oDicCJ(arrData2(i, 1)) = i
    
33.     Next i
    
34.     Dim rngRed As Range, rRow As Range, iR As Long, sSub, iLoc
    
35.     Set rngData2 = oSht1.Range("A1").CurrentRegion
    
36.     arrData = rngData2.Value
    
37.     For i = 2 To UBound(arrData)
    
38.         sKey = arrData(i, 2)
    
39.         If Len(sKey) > 0 Then
    
40.             If oDicCJ.exists(sKey) Then
    
41.                 iR = oDicCJ(sKey)
    
42.                 arrData(i, 3) = arrData2(iR, 2) ' 班级
    
43.                 arrData(i, 4) = arrData2(iR, 3) ' 语文
    
44.                 arrData(i, 5) = arrData2(iR, 4) ' 数学
    
45.                 If oDicJP.exists(sKey) Then
    
46.                     arrData(i, 6) = ""
    
47.                 Else
    
48.                     arrData(i, 6) = arrData2(iR, 5) ' 英语
    
49.                 End If
    
50.                 For j = 3 To 6
    
51.                     If Len(arrData(i, j)) = 0 Then
    
52.                         arrData(i, j) = Application.RandBetween(aMin(iLoc - 3), aMax(iLoc - 3))
    
53.                         Set rngRed = MergeRng(rngRed, oSht1.Cells(i, j))
    
54.                     End If
    
55.                 Next
    
56.                 arrData(i, 13) = arrData2(iR, 16) ' 组合
    
57.                 If Len(arrData(i, 13)) = 0 Then
    
58.                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 7).Resize(1, 7))
    
59.                 Else
    
60.                     For k = 1 To Len(arrData(i, 13))
    
61.                         sSub = Mid(arrData(i, 13), k, 1)
    
62.                         iLoc = InStr(SUBJECT, sSub)
    
63.                         If iLoc > 0 Then
    
64.                             If Len(arrData2(iR, aIdx(iLoc - 1))) = 0 Then
    
65.                                 arrData(i, iLoc + 3) = Application.RandBetween(aMin(iLoc - 1), aMax(iLoc - 1))
    
66.                                 Set rngRed = MergeRng(rngRed, oSht1.Cells(i, iLoc + 3))
    
67.                             Else
    
68.                                 arrData(i, iLoc + 3) = arrData2(iR, aIdx(iLoc - 1))
    
69.                             End If
    
70.                         End If
    
71.                     Next
    
72.                 End If
    
73.             Else
    
74.                 If oDicNL.exists(sKey) Then
    
75.                     iR = oDicNL(sKey)
    
76.                     arrData(i, 3) = arrData3(iR, 3) ' 班级
    
77.                     arrData(i, 13) = arrData3(iR, 2)
    
78.                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 4).Resize(1, COLCNT - 4))
    
79.                 Else
    
80.                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 3).Resize(1, COLCNT - 2))
    
81.                 End If
    
82.             End If
    
83.         End If
    
84.     Next
    
85.     rngData2.Value = arrData
    
86.     If Not rngRed Is Nothing Then
    
87.         rngRed.Interior.Color = vbRed
    
88.     End If
    
89. End Sub
    
90. 
    
91. Function MergeRng(rngMain As Range, rngNew As Range)
    
92.     If rngMain Is Nothing Then
    
93.         Set rngMain = rngNew
    
94.     Else
    
95.         Set rngMain = Application.Union(rngMain, rngNew)
    
96.     End If
    
97.     Set MergeRng = rngMain
    
98. End Function
    
99. 
    
100. 
     

复制代码

taller

sxdmsz

老师你好，不在上次成绩表里的学生90就没有随机生成成绩。

sunya_0529

WPS里的JSA练习一下——

sxdmsz

sunya_0529 发表于 2024-3-17 18:47
WPS里的JSA练习一下——

WPS里面没弄过，尝试来运行一下，谢谢

sunshuangzhong

有什么实际意义吗？

taller

1. 
   
2. Option Explicit
   
3. Sub Demo2()
   
4.     Dim oDicCJ, oDicJP, oDicNL, rngData2 As Range
   
5.     Dim i As Long, j As Long, k As Long, sKey As String
   
6.     Dim arrData, arrData2, arrData3, aMin, aMax, aIdx
   
7.     Dim oSht1 As Worksheet, oSht2 As Worksheet
   
8.     Const COLCNT = 13
   
9.     Const SUBJECT = "语数英物历化生政地"
   
10.     aMin = Split("60 20 40 10 30 10 30 30 30")
    
11.     aMax = Split("85 50 65 30 50 30 45 50 51")
    
12.     aIdx = Split("3 4 5 6 13 7 9 11 14")
    
13.     Set oSht1 = ThisWorkbook.Sheets("1")
    
14.     Set oSht2 = ThisWorkbook.Sheets("上次成绩")
    
15.     Set oDicCJ = CreateObject("scripting.dictionary")
    
16.     Set oDicJP = CreateObject("scripting.dictionary")
    
17.     Set oDicNL = CreateObject("scripting.dictionary")
    
18.     ' testing ============
    
19.     oSht1.Range("C2:M7").Interior.Color = xlNone
    
20.     oSht1.Range("C2:M7").Interior.Color = xlNone
    
21.     '============
    
22.     arrData3 = oSht2.Range("V1").CurrentRegion.Value
    
23.     For i = LBound(arrData3) + 1 To UBound(arrData3)
    
24.         oDicNL(arrData3(i, 1)) = i
    
25.     Next i
    
26.     arrData2 = oSht2.Range("AB1").CurrentRegion.Value
    
27.     For i = LBound(arrData2) + 1 To UBound(arrData2)
    
28.         oDicCJ(arrData2(i, 1)) = ""
    
29.     Next i
    
30.     Set rngData2 = oSht2.Range("A1").CurrentRegion
    
31.     arrData2 = rngData2.Value
    
32.     For i = LBound(arrData2) + 1 To UBound(arrData2)
    
33.         oDicCJ(arrData2(i, 1)) = i
    
34.     Next i
    
35.     Dim rngRed As Range, rRow As Range, iR As Long, sSub, iLoc
    
36.     Set rngData2 = oSht1.Range("A1").CurrentRegion
    
37.     arrData = rngData2.Value
    
38.     For i = 2 To UBound(arrData)
    
39.         sKey = arrData(i, 2)
    
40.         If Len(sKey) > 0 Then
    
41.             If oDicCJ.exists(sKey) Then
    
42.                 iR = oDicCJ(sKey)
    
43.                 arrData(i, 3) = arrData2(iR, 2) ' 班级
    
44.                 arrData(i, 4) = arrData2(iR, 3) ' 语文
    
45.                 arrData(i, 5) = arrData2(iR, 4) ' 数学
    
46.                 If oDicJP.exists(sKey) Then
    
47.                     arrData(i, 6) = ""
    
48.                 Else
    
49.                     arrData(i, 6) = arrData2(iR, 5) ' 英语
    
50.                 End If
    
51.                 For j = 3 To 6
    
52.                     If Len(arrData(i, j)) = 0 Then
    
53.                         arrData(i, j) = Application.RandBetween(aMin(iLoc - 3), aMax(iLoc - 3))
    
54.                         Set rngRed = MergeRng(rngRed, oSht1.Cells(i, j))
    
55.                     End If
    
56.                 Next
    
57.                 arrData(i, 13) = arrData2(iR, 16) ' 组合
    
58.                 If Len(arrData(i, 13)) = 0 Then
    
59.                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 7).Resize(1, 7))
    
60.                 Else
    
61.                     For k = 1 To Len(arrData(i, 13))
    
62.                         sSub = Mid(arrData(i, 13), k, 1)
    
63.                         iLoc = InStr(SUBJECT, sSub)
    
64.                         If iLoc > 0 Then
    
65.                             If Len(arrData2(iR, aIdx(iLoc - 1))) = 0 Then
    
66.                                 arrData(i, iLoc + 3) = Application.RandBetween(aMin(iLoc - 1), aMax(iLoc - 1))
    
67.                                 Set rngRed = MergeRng(rngRed, oSht1.Cells(i, iLoc + 3))
    
68.                             Else
    
69.                                 arrData(i, iLoc + 3) = arrData2(iR, aIdx(iLoc - 1))
    
70.                             End If
    
71.                         End If
    
72.                     Next
    
73.                 End If
    
74.             Else
    
75.                 If oDicNL.exists(sKey) Then
    
76.                     iR = oDicNL(sKey)
    
77.                     arrData(i, 3) = arrData3(iR, 3) ' 班级
    
78.                     For j = 3 To 6
    
79.                         If Len(arrData(i, j)) = 0 Then
    
80.                             arrData(i, j) = Application.RandBetween(aMin(iLoc - 3), aMax(iLoc - 3))
    
81.                             Set rngRed = MergeRng(rngRed, oSht1.Cells(i, j))
    
82.                         End If
    
83.                     Next
    
84.                     arrData(i, 13) = arrData3(iR, 2) ' 组合
    
85.                     If Len(arrData(i, 13)) = 0 Then
    
86.                         Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 7).Resize(1, 7))
    
87.                     Else
    
88.                         For k = 1 To Len(arrData(i, 13))
    
89.                             sSub = Mid(arrData(i, 13), k, 1)
    
90.                             iLoc = InStr(SUBJECT, sSub)
    
91.                             If iLoc > 0 Then
    
92.                                 If Len(arrData(i, iLoc + 3)) = 0 Then
    
93.                                     arrData(i, iLoc + 3) = Application.RandBetween(aMin(iLoc - 1), aMax(iLoc - 1))
    
94.                                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, iLoc + 3))
    
95.                                 End If
    
96.                             End If
    
97.                         Next
    
98.                     End If
    
99.                 Else
    
100.                     Set rngRed = MergeRng(rngRed, oSht1.Cells(i, 3).Resize(1, COLCNT - 2))
     
101.                 End If
     
102.             End If
     
103.         End If
     
104.     Next
     
105.     rngData2.Value = arrData
     
106.     If Not rngRed Is Nothing Then
     
107.         rngRed.Interior.Color = vbRed
     
108.     End If
     
109. End Sub
     

复制代码