求助！这个代码怎么写

liaolulu333

如图，表1是一个统计表，数据挺多的，随便截取一小部分。

表2的净重和毛重，即G列和H列，如何用VBA根据表1的数据，来自动填写。
求助大神解惑，谢谢。

            

excel玉米

不在电脑边，手机回复，有误勿怪。
Sub test()
Dim arr,brr,i%,j%
Arr=sheet1.currentregion
Brr=sheet2.currentregion
For i=2  to  ubound(brr)
   For j=2  to ubound(arr)
       If brr(i,1)=arr(j,i) then
           If len(brr(i,2))>0 then
             Brr(i,7)=arr(j,4):  Brr(i,8)=arr(j,5)
           Else
             Brr(i,7)=arr(j,4)/ar(j,3)*brr(i,6)
             If brr(i,6)＞arr(j,3)/2  then
                 Brr(i,8)=brr(i,7)+1
             Else
                Brr(i,8)=brr(i,7)+0.5
             End if
           End if
        End if
   Next j
Next i
Sheet2.cells.clear
Sheet2.cells(1,1).resize(ubound(brr)),ubound(brr,2))=brr
End  sub

ykcbf1100

没看清规则。效果图中第一行数据，数量1000和数量200，净重和毛重怎么是一样的呢？

liaolulu333

ykcbf1100 发表于 2024-3-24 08:13
没看清规则。效果图中第一行数据，数量1000和数量200，净重和毛重怎么是一样的呢？

左边数量1000是出货数据，5箱200就是1000啊。那有两个重量一样？

ykcbf1100

liaolulu333 发表于 2024-3-24 08:33
左边数量1000是出货数据，5箱200就是1000啊。那有两个重量一样？

你要填写的是净重和毛重，不是数量。我问的是，数量不同，难道净重不变吗？

liaolulu333

ykcbf1100 发表于 2024-3-24 08:46
你要填写的是净重和毛重，不是数量。我问的是，数量不同，难道净重不变吗？

装箱数量不同，净毛重肯定要变呀。第1个表格是我统计的整数箱 净毛重，第2个表格是要填写的净毛重。第4行我计算错了，不是6.2，应该是12.3/400*100=3.1，取1位小数点。

liaolulu333

ykcbf1100 发表于 2024-3-24 08:46
你要填写的是净重和毛重，不是数量。我问的是，数量不同，难道净重不变吗？

这个只记录的是单箱数量的净毛重，不是算总数量的净毛重。

dragonthree

怎么算净重和毛重？那么净重和毛重差0.5(如第4行）是什么意思？毛重=净重的数量+0.5？

ykcbf1100

liaolulu333 发表于 2024-3-24 08:54
装箱数量不同，净毛重肯定要变呀。第1个表格是我统计的整数箱 净毛重，第2个表格是要填写的净毛重。第4行 ...

你第4行原来是对的，你是不到半箱算半箱的。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.24
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("1")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 5)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 1)
    
11.         d(s) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
    
12.     Next
    
13.     With Sheets("2")
    
14.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 8)
    
16.         For i = 2 To UBound(arr)
    
17.             s = arr(i, 1)
    
18.             If d.Exists(s) Then
    
19.                 t = arr(i, 6) / d(s)(1)
    
20.                 t1 = Fix(t)
    
21.                 t2 = t - t1
    
22.                 If t2 * arr(i, 6) >= 0.5 * d(s)(1) Then m = t1 + 1 Else m = t1 + 0.5
    
23.                 If t2 = 0 Then m = t
    
24.                 arr(i, 7) = Round(d(s)(2) * m, 1)
    
25.                 arr(i, 8) = Round(d(s)(3) * m, 1)
    
26.             End If
    
27.         Next
    
28.         .[a1].Resize(r, 8) = arr
    
29.     End With
    
30.     Set d = Nothing
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码