如何提取分数

jyq8

如何提取各考生的分数对应准考证号

tudarong

是根据准考证号，将图片中sheet1的分数，提取到sheet2表格中吗？

不知道为什么

tudarong 发表于 2018-7-8 14:47
是根据准考证号，将图片中sheet1的分数，提取到sheet2表格中吗？

用了一个比较笨的方法，不过还是能达到你的效果：

不知道为什么

tudarong 发表于 2018-7-8 14:47
是根据准考证号，将图片中sheet1的分数，提取到sheet2表格中吗？

如图，代码供测试

chaohuahch

1. Sub tjcj()
   
2. Dim arr, i%, k%, kk%, brr()
   
3. t = Timer
   
4. Application.ScreenUpdating = False
   
5. nRow = Sheets("sheet1").Range("a" & Rows.Count).End(3).Row
   
6. For kk = 1 To nRow Step 9
   
7. With Sheets("sheet1")
   
8.     arr = .Range("a" & kk).Resize(9, 4)
   
9.     nArr = UBound(arr)
   
10.     ReDim brr(1 To 20, 1 To 2)
    
11.         For i = 1 To nArr
    
12.            brr(i, 1) = arr(i, 1)
    
13.            brr(i, 2) = arr(i, 2)
    
14.         Next i
    
15.         
    
16.         For i = nArr + 1 To 2 * nArr
    
17.            brr(i, 1) = arr(i - nArr, 3)
    
18.            brr(i, 2) = arr(i - nArr, 4)
    
19.    
    
20.         Next i
    
21.     End With
    
22.      
    
23. With Sheets("sheet2")
    
24.   nrow1 = Range("a" & Rows.Count).End(3).Row + 1
    
25.     For i = 1 To UBound(brr)
    
26.      For j = 1 To UBound(brr)
    
27.      If Cells(1, i) = brr(j, 1) Then Cells(nrow1, i) = brr(j, 2)
    
28.      Next j
    
29.     Next i
    
30. End With
    
31. Next kk
    
32. 
    
33. Application.ScreenUpdating = True
    
34. 
    
35. MsgBox "本程序运行时间" & Format(Timer - t, "0.000")
    
36. End Sub
    
37. 
    

复制代码

jyq8

不知道为什么 发表于 2018-7-8 16:30
如图，代码供测试

你好请将代码复制成文本可以吗，谢谢。

不知道为什么

jyq8 发表于 2018-7-8 22:19
你好请将代码复制成文本可以吗，谢谢。

抄写代码更有助于学习！

chaohuahch

我用字典写的VBA程序如下。用字典速度更快。

jyq8

chaohuahch 发表于 2018-7-8 22:39
我用字典写的VBA程序如下。用字典速度更快。

代码可复制方便点，谢谢。

hb-yy

学习…………