[第25问]帮我把表格中的函数变成VBA代码

hbhs2022

见表格说明。

吴中泉

如图

吴中泉

1. Private Sub CommandButton1_Click()
   
2. 'wzq 2023.7.17
   
3. Dim arr, i&, r&, brr, n&, j%
   
4. Sheet1.Activate
   
5. [F4:AI10000].ClearContents
   
6. [F4:AI10000].NumberFormatLocal = "@"
   
7. r = Cells(Rows.Count, 4).End(xlUp).Row
   
8. arr = Range("C4:E" & r)
   
9. ReDim brr(1 To UBound(arr), 1 To 30)
   
10. For i = 1 To UBound(arr)
    
11.     For j = 1 To 3
    
12.         s = arr(i, j) + j * 10 - 9
    
13.         brr(i, s) = Cells(3, 5 + s)
    
14.     Next
    
15. Next
    
16. For j = 1 To 30
    
17.     n = 0
    
18.     For i = 1 To UBound(arr)
    
19.         If brr(i, j) = "" Then
    
20.             If i = 1 Then n = 1 Else n = n + 1
    
21.             brr(i, j) = n
    
22.         Else
    
23.             n = 0
    
24.         End If
    
25.     Next
    
26. Next
    
27. Sheet1.[F4].Resize(UBound(brr), 30) = brr
    
28. End Sub
    

复制代码

hbhs2022

吴中泉 发表于 2023-7-20 19:25

谢谢你！刚才用搜狗图片转文字，复制代码，原来复制的代码有误，识别不准确。图片代码是正确的。

hbhs2022

吴中泉 发表于 2023-7-20 19:22
如图

是正确的。谢谢你！

吴中泉

hbhs2022 发表于 2023-7-20 19:50
是正确的。谢谢你！

不用谢，与之前其它代码相似，只要稍微改一下，不麻烦的。

hbhs2022

吴中泉 发表于 2023-7-20 19:58
不用谢，与之前其它代码相似，只要稍微改一下，不麻烦的。

我的第20问和这个问题有点相似，是蓝版主帮我写的。我本来是想修改他写的代码套用在这个表格里面，可是修改不成功，所以上传附件求助问题。