求大神帮忙用VBA将1表和2表生成3表数据，感谢感谢

fzxba

chinasun0 发表于 2023-2-21 18:12
用VBA的方法将表1和表2生成表3格式                               
1-N班表1和表2均有，表1中总分*表2中各科占比（已实现）                               
Z ...

1. Sub test0()
   
2.   Dim ar, br, cr(), Dict As Object
   
3.   Dim i As Long, j As Long, k As Long, p As Long
   
4.   ar = Sheet1.Range("A1").CurrentRegion
   
5.   br = Sheet2.Range("A1").CurrentRegion
   
6.   ReDim cr(1 To UBound(ar) * (UBound(br, 2) - 1), 1 To 3)
   
7.   Set Dict = CreateObject("Scripting.Dictionary")
   
8.   For i = 2 To UBound(br)
   
9.     Dict.Add br(i, 1), i
   
10.   Next
    
11.   For i = 2 To UBound(ar)
    
12.     If Dict.Exists(ar(i, 1)) Then
    
13.       p = Dict(ar(i, 1))
    
14.       For j = 2 To UBound(br, 2)
    
15.         k = k + 1
    
16.         cr(k, 1) = ar(i, 1)
    
17.         cr(k, 2) = Replace(br(1, j), "占比", "")
    
18.         cr(k, 3) = ar(i, 2) * Val(br(p, j))
    
19.       Next
    
20.     Else
    
21.       k = k + 1
    
22.       cr(k, 1) = ar(i, 1)
    
23.       cr(k, 2) = ar(1, 2)
    
24.       cr(k, 3) = ar(i, 2)
    
25.     End If
    
26.   Next
    
27.   With Sheet3.Range("A1")
    
28.     .CurrentRegion.ClearContents
    
29.     .Resize(, UBound(cr, 2)) = Split("班级 科目 成绩")
    
30.     .Offset(1).Resize(k, UBound(cr, 2)) = cr
    
31.   End With
    
32.   Set Dict = Nothing
    
33.   Beep
    
34. End Sub

复制代码

chinasun0

fzxba 发表于 2023-2-22 08:26

多谢大神，佩服