因为资料太多，想把函数换成VBA,怎么取结余数的最小值

yancjm

想把统计表中T列 的函数公式换成VBA，但是代码不太会，在网上找来代码，改出来不正确，请大家帮忙看看以下代码如何修改一下

Private Sub CommandButton1_Click()
    s = "(IF((PH=""品号"")*(RQ=日期),JY))"
    For i = 5 To [T6].CurrentRegion.Rows.Count
        ss = Replace((Replace(s, "品号", Cells(i, "A"))), Cells(i, "T"))
        Cells(i, "T") = Evaluate("=Min" & ss)

    Next
End Sub

蓝桥玄霜

请见代码。
运用工作表变化事件即可。

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, dic(1)
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = Sheets("sys").[a2].CurrentRegion
  For i = 3 To UBound(arr, 1)
    If dic(0).exists(arr(i, 4)) Then
      If arr(i, 9) < 0 Then
        If dic(1)(arr(i, 4)) >= 0 Then
          dic(0)(arr(i, 4)) = arr(i, 1)
          dic(1)(arr(i, 4)) = arr(i, 9)
        Else
          If arr(i, 9) > dic(1)(arr(i, 4)) Then
            dic(0)(arr(i, 4)) = arr(i, 1)
            dic(1)(arr(i, 4)) = arr(i, 9)
          End If
        End If
      End If
    Else
      dic(0)(arr(i, 4)) = arr(i, 1)
      dic(1)(arr(i, 4)) = arr(i, 9)
    End If
  Next
  Sheets("统计").Activate
  arr = Range("a9:t" & Cells(Rows.Count, "a").End(xlUp).Row)
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1)
    If dic(0).exists(arr(i, 1)) Then
      If dic(1)(arr(i, 1)) < 0 Then brr(i, 1) = dic(0)(arr(i, 1))
    End If
  Next
  [t9].Resize(UBound(brr, 1)) = brr
End Sub

zhenghui13

请测试一下，无法上传附件。

1. 'http://club.excelhome.net/thread-1483875-1-1.html
   
2. '2019.06.18
   
3. Sub Get_Negative_Max()
   
4. Dim i%, arr
   
5. Dim m%
   
6. Dim prod$
   
7. Dim StockDate
   
8. arr = Sheets("SYS").UsedRange
   
9. With Sheet3
   
10.     'Loop row in Worksheet
    
11.     For m = 6 To .Cells(65536, 1).End(xlUp).Row
    
12.         prod = .Cells(m, 1)
    
13.         StockDate = ""
    
14.         'exclude blank production
    
15.         If Not prod = "" Then
    
16.             StockDate = Look_Negative_Max(arr, prod)
    
17.             .Cells(m, 20) = StockDate
    
18.         End If
    
19.     Next m
    
20. End With
    
21. Debug.Print
    
22. End Sub
    
23. 
    
24. 'function for looking the Negative Max
    
25. '**If can't find balance, return ""
    
26. Function Look_Negative_Max(arr, prod)
    
27. Dim i
    
28. Dim Sk$, sk_balance#
    
29. Dim max_balance, tmp
    
30. tmp = ""
    
31. max_balance = -99999                'Initial balance
    
32. For i = 4 To UBound(arr)
    
33.     Sk = arr(i, 4)                  'Product
    
34.     sk_balance = arr(i, 9)          'Balance
    
35.     If Sk = prod Then
    
36.         If sk_balance < 0 Then      'Negative
    
37.             If sk_balance > max_balance Then
    
38.                 max_balance = sk_balance
    
39.                 tmp = arr(i, 1)     'Get Date
    
40.             End If
    
41.         End If
    
42.     End If
    
43. Next i
    
44. Look_Negative_Max = tmp    'Return
    
45. End Function

复制代码

yancjm

一把小刀闯天下 发表于 2019-6-18 12:07
Option Explicit

Sub test()

OK了，非常感谢！

yancjm

zhenghui13 发表于 2019-6-18 12:10
请测试一下，无法上传附件。

测试通过，OK,非常感谢！

yancjm

蓝桥玄霜 发表于 2019-6-18 11:31
请见代码。
运用工作表变化事件即可。

蓝板抱歉，是我没有描述清楚问题，我是取T列日期的最小值，感谢回复！S列如果可以把=IF(A9="","",SUMIF($E$5:$R$5," 入库数量",$E9:$R9)-SUMIF($E$5:$R$5," 出库数量",$E9:$R9))这个函数换成VBA，那是帮了大忙了