有点难，想用VBA实现对单元格赋值公式，类型存在多种情况

canyng2

问题，如图

xlj310

1. Sub 测试()
   
2.     With ThisWorkbook.ActiveSheet
   
3.         数据 = .Range(.[a1], .UsedRange).Columns("A:E").Value
   
4.         Set Dic主皮 = CreateObject("scripting.dictionary")
   
5.         For 行 = 1 To UBound(数据)
   
6.             If 数据(行, 1) Like "主皮*" Then
   
7.                 主皮序号 = Replace(数据(行, 1), "主皮", "")
   
8.                 主皮序号 = Replace(主皮序号, ":", "")
   
9.                 If 主皮序号 Like "*-*" Then 主皮序号 = Split(主皮序号, "-")(0) & ""
   
10.                 主皮序号 = 主皮序号 & "》"
    
11.                 Dic主皮(主皮序号) = Dic主皮(主皮序号) & "," & Cells(行 + 1, "E").Address
    
12.                 If 上一主皮 <> "" Then Dic主皮(上一主皮) = Dic主皮(上一主皮) & ":" & Cells(行 - 1, "E").Address
    
13.                 上一主皮 = 主皮序号
    
14.             End If
    
15.             If 行 = UBound(数据) Then Stop: Dic主皮(主皮序号) = Dic主皮(主皮序号) & ":" & Cells(行, "E").Address
    
16.         Next
    
17.         For Each Key In Dic主皮.keys
    
18.             Dic主皮(Key) = "=sum(" & Mid(Dic主皮(Key), 2) & ")"
    
19.         Next
    
20.         With Dic主皮
    
21.             ThisWorkbook.ActiveSheet.[G4].Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))     '转置输出
    
22.         End With
    
23.     End With
    
24. End Sub
    
25. 
    

复制代码

chxw68

这个题目还比较新鲜。

z865593849

练手

dambcer

z865593849 发表于 2024-12-14 10:19
练手

确实，用了VBA干嘛还写公式，直接出结果

chxw68

换个写法，练习。

canyng2

xlj310 发表于 2024-12-14 08:24

运行了下，有点问题，求和公式不对

canyng2

chxw68 发表于 2024-12-14 08:39
这个题目还比较新鲜。

运行了，是对的

canyng2

dambcer 发表于 2024-12-14 10:38
确实，用了VBA干嘛还写公式，直接出结果

因为数据自动处理后，后期还需要根据实际需求修改用料情况，假如VBA直接得结果，不方便后期做小调节

canyng2

chxw68 发表于 2024-12-14 12:27
换个写法，练习。

嗯嗯，就是做出来大概要多少分钟呢？