根据特定条件提取最小日期的问题怎么解决？

liuhankun · 发表于 2019-4-29 16:15

本帖最后由 liuhankun 于 2019-4-29 16:18 编辑

SYKLGSWYT 发表于 2019-4-26 13:46

我把应该正确的结果放到右边了，希望用VBA实现正确的最小日期提取，谢谢！

liuhankun · 发表于 2019-4-29 16:16

本帖最后由 liuhankun 于 2019-4-29 16:20 编辑

爱疯发表于 2019-4-27 11:21
建议只准备几个数据，但手动给出结果

我把应该正确的结果放到右边了，希望用VBA实现正确的最小日期提取，谢谢！

过江龙 · 发表于 2019-4-29 17:30

本帖最后由过江龙于 2019-4-29 17:36 编辑

liuhankun 发表于 2019-4-29 16:14
我把应该正确的结果放到右边了，希望用VBA实现正确的最小日期提取，谢谢！
其实就是实现minifs函数的功 ...

你确定1002的最早入库日期正确吗？

Public Sub 比对数据()
Dim arr, brr, i, j, h
Application.ScreenUpdating = False
brr = Sheet1.Range("A2:D" & Sheet1.[B65536].End(3).Row)
arr = Sheet2.Range("A2:D" & Sheet2.[B65536].End(3).Row)

For j = 1 To UBound(arr)
h = 0
For i = 1 To UBound(brr)

   If arr(j, 1) = brr(i, 1) And brr(i, 4) <> "已处理" Then
      If arr(j, 3) = "" Then
         arr(j, 3) = brr(i, 3)
      Else
         If arr(j, 3) > brr(i, 3) Then
         arr(j, 3) = brr(i, 3)
         End If
      End If
      h = 1
   End If
Next
If h = 0 Then
   arr(j, 3) = "无记录"
End If
Next
Sheet2.Range("C2").Resize(UBound(arr)) = Application.WorksheetFunction.Index(arr, 0, 3)

   Erase arr, brr
MsgBox "OK"
Application.ScreenUpdating = True
End Sub

最近日期提取.zip (14.17 KB, 下载次数: 15)

liuhankun · 发表于 2019-4-29 18:52

过江龙发表于 2019-4-29 17:30
你确定1002的最早入库日期正确吗？
Public Sub 比对数据()
Dim arr, brr, i, j, h

不好意思，看错位置了，1002写错日期了

liuhankun · 发表于 2019-4-29 18:59

爱疯发表于 2019-4-29 16:31
Sub test()
Dim A, d, i, k
Set d = CreateObject("scripting.dictionary")

问题已解决，非常感谢大神！

liuhankun · 发表于 2019-4-29 18:59

过江龙发表于 2019-4-29 17:30
你确定1002的最早入库日期正确吗？
Public Sub 比对数据()
Dim arr, brr, i, j, h

问题已解决，非常感谢大神！

SYKLGSWYT · 发表于 2019-5-2 14:01

		自动登录	找回密码
密码			注册