想要麻烦帮我改良一下这个VBA公式

mind1238

想要麻烦帮我改单一下这个公式
也是按照原有的表中的规则
现在就是改良一下
逻辑是一样的
中间增加了厚度

Option Explicit

Sub test()
  Dim arr, i, dic, t
  arr = [a1].CurrentRegion.Offset(1)
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To UBound(arr, 1) - 1
    dic(arr(i, 1) & arr(i, 2) & "|" & arr(i, 3)) = arr(i, 4)
  Next
  arr = [f1].CurrentRegion.Offset(1)
  For i = 1 To UBound(arr, 1) - 1
    t = arr(i, 2) & arr(i, 3) & "|" & arr(i, 4)
    arr(i, 5) = IIf(dic.exists(t), Round(dic(t), 2), vbNullString)
  Next
  [f2].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = arr
End Sub

lsc900707

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.   Dim arr, i, dic, t
   
5.   arr = [a1].CurrentRegion.Offset(1)
   
6.   Set dic = CreateObject("scripting.dictionary")
   
7.   For i = 1 To UBound(arr, 1) - 1
   
8.     dic(arr(i, 1) & arr(i, 2) & "|" & arr(i, 3)) = arr(i, 5)
   
9.   Next
   
10.   arr = [g1].CurrentRegion.Offset(1)
    
11.   For i = 1 To UBound(arr, 1) - 1
    
12.     t = arr(i, 2) & arr(i, 3) & "|" & arr(i, 4)
    
13.     arr(i, 5) = IIf(dic.exists(t), Round(dic(t), 2), vbNullString)
    
14.   Next
    
15.   [g2].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = arr
    
16. End Sub

复制代码

mind1238

lsc900707 发表于 2018-10-9 12:36

非常感谢你回复我但是要再改一下这个公式
厚度那一栏没能显示阿是我的原数据没有做得好
十分感谢你

lsc900707

mind1238 发表于 2018-10-9 14:18
非常感谢你回复我但是要再改一下这个公式
厚度那一栏没能显示阿是我的原数据没有做得好
十分感谢你

我喜欢这样写：

1. Sub test()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         s = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)
   
6.         d(s) = arr(i, 5)
   
7.     Next
   
8.     brr = [g1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         s = brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 5)
    
11.         brr(i, 6) = Round(d(s), 2)
    
12.     Next
    
13.     [g1].CurrentRegion = brr
    
14. End Sub

复制代码

mind1238

lsc900707 发表于 2018-10-9 14:38
我喜欢这样写：

又学习一个新的公式了！
太厉害了你们都！
非常感谢

mind1238

lsc900707 发表于 2018-10-9 14:38
我喜欢这样写：

我刚刚用您新做的公式试验了
有一数据不全面的

lsc900707

mind1238 发表于 2018-10-9 14:57
我刚刚用您新做的公式试验了
有一数据不全面的

两个厚度：一个有小数点，一个没小数点！