像这种表格能用函数实现吗？求老师帮写公式

liaozicai318

各位老师好，如附件工作表，B列-E列为基础数据，F列-H列为手工录入结果，可不可以把F列-H列的结果以函数实现？

苏小亓

工作薄1.zip (14.81 KB, 下载次数: 8)

2024-4-28 15:26 上传

点击文件名下载附件

kuangben8

1. Sub 展开()
   
2.     Dim arr, brr()
   
3.     Dim m%, n%, k%, j%
   
4.     arr = Worksheets("001").Range("B2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
   
5.     ReDim brr(10000, 2)
   
6.     For m = 1 To UBound(arr, 1)
   
7.         k = arr(m, 3) / arr(m, 2)
   
8.         For n = 1 To arr(m, 3)
   
9.             brr(j, 0) = arr(m, 1)
   
10.             brr(j, 1) = Int((n - 1) / k) + 1 & "层"
    
11.             brr(j, 2) = Int((n - 1) / k) + 1 & Format(((n - 1) Mod k) + 1, "00")
    
12.             j = j + 1
    
13.         Next
    
14.     Next
    
15.     arr = WorksheetFunction.Transpose(brr)
    
16.     ReDim Preserve arr(1 To 3, 1 To j)
    
17.     Range("F2").Resize(j, 3).Value = WorksheetFunction.Transpose(arr)
    
18. End Sub

复制代码

liaozicai318

苏小亓 发表于 2024-4-28 15:26

老师辛苦，己解决