关于按条件取值

sampsonpon

关于按条件取值，具体需求如图：

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.19
   
2.     ReDim brr(1 To 1000, 1 To 2)
   
3.     With Sheets("Picking List")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         Set Rng = .[a2].Resize(r - 1, 8)
   
6.         Rng.Sort .Cells(2, "c"), 1
   
7.         arr = Rng.Value
   
8.         For i = 1 To UBound(arr)
   
9.             Sum = Sum + arr(i, 6)
   
10.         Next
    
11.         sum1 = Application.WorksheetFunction.Round(Sum / 2, 4)
    
12.         .[l3] = sum1: Sum = 0
    
13.         For i = 1 To UBound(arr)
    
14.             Sum = Sum + arr(i, 6)
    
15.             If Sum > sum1 Then
    
16.                 s1 = Sum - arr(i, 6) - sum1
    
17.                 s2 = Sum - sum1
    
18.                 If Abs(s1) < Abs(s2) Then
    
19.                     r = i - 1
    
20.                 Else
    
21.                     r = i
    
22.                 End If
    
23.                 Exit For
    
24.             End If
    
25.         Next
    
26.         For i = 1 To r
    
27.             m = m + 1
    
28.             brr(m, 1) = arr(i, 2)
    
29.         Next
    
30.         For i = r + 1 To UBound(arr)
    
31.             n = n + 1
    
32.             brr(n, 2) = arr(i, 2)
    
33.         Next
    
34.     End With
    
35.     With Sheets("Picking Order")
    
36.         .UsedRange.Offset(1) = ""
    
37.         .[a2].Resize(1000, 2) = brr
    
38.     End With
    
39. End Sub
    

复制代码

sampsonpon

ykcbf1100 发表于 2024-5-19 20:44
附件供参考。。。

这里不对，没有取完。因为C列它遇到了相同项内容

ykcbf1100

改好了，你再试一下。