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

liuhankun · 发表于 2019-4-26 11:03

各位大神，请问根据条件提取最小日期的问题怎么解决？谢谢！

爱疯 · 发表于 2019-4-26 11:03

Sub test()
Dim A, d, i, k
Set d = CreateObject("scripting.dictionary")

'1）写入
Sheets(1).Select
A = Range("a1").CurrentRegion
For i = 2 To UBound(A)
      If A(i, 4) <> "已处理" Then
         k = A(i, 1) & A(i, 2)
         If d.exists(k) Then
            If A(i, 3) < d(k) Then d(k) = A(i, 3)
         Else
            d(k) = A(i, 3)
         End If
      End If
Next i

'2）查询
Sheets(2).Select
i = Range("a65536").End(xlUp).Row
Range("c2:c" & i) = "无记录"
A = Range("a1").CurrentRegion
For i = 2 To UBound(A)
      k = A(i, 1) & A(i, 2)
      If d.exists(k) Then A(i, 3) = d(k)
Next i
[a1].Resize(UBound(A), UBound(A, 2)) = A

End Sub

1.rar (19.97 KB, 下载次数: 7)

过江龙 · 发表于 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)

过江龙 · 发表于 2019-4-26 13:03

代码如下：
Public Sub 比对数据()
Dim arr, brr, i As Integer, j As Integer
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)
For i = 1 To UBound(brr)
   If brr(i, 4) = "已处理" And arr(j, 1) = brr(i, 1) Then
   arr(j, 4) = "已处理"
   arr(j, 3) = ""
   End If
   If arr(j, 1) = brr(i, 1) And arr(j, 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
   End If
Next
Next
Sheet2.Range("C2").Resize(UBound(arr)) = Application.WorksheetFunction.Index(arr, 0, 3)
   Erase arr, brr
MsgBox "OK"
Application.ScreenUpdating = True
End Sub

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

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

liuhankun · 发表于 2019-4-26 22:58

本帖最后由 liuhankun 于 2019-4-26 23:13 编辑

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

非常感谢大神的努力，但是针对同一编码，并没有正确提取出同一个编码的最小日期，因为同一编码有多次入库记录，也就有多个日期，我只需要最小那个日期，填入表2对应编码的后面。看看还有其它方法吗？

liuhankun · 发表于 2019-4-26 22:59

过江龙发表于 2019-4-26 13:03
代码如下：
Public Sub 比对数据()
Dim arr, brr, i As Integer, j As Integer

非常感谢，但是没有得出正确的结果！

爱疯 · 发表于 2019-4-27 11:21

建议只准备几个数据，但手动给出结果

过江龙 · 发表于 2019-4-28 09:31

liuhankun 发表于 2019-4-26 22:59
非常感谢，但是没有得出正确的结果！

正确的结果是什么？弄一个效果出来，不然真的很难猜。

过江龙 · 发表于 2019-4-28 09:44

liuhankun 发表于 2019-4-26 22:59
非常感谢，但是没有得出正确的结果！

把空值标注出来了。
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 brr(i, 4) = "已处理" And arr(j, 1) = brr(i, 1) Then
   arr(j, 4) = "已处理"
   arr(j, 3) = ""
   h = 1
   End If
   If arr(j, 1) = brr(i, 1) And arr(j, 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 (15.9 KB, 下载次数: 6)

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

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

过江龙发表于 2019-4-28 09:44
把空值标注出来了。
Public Sub 比对数据()
Dim arr, brr, i, j, h

我把应该正确的结果放到右边了，希望用VBA实现正确的最小日期提取，谢谢！
其实就是实现minifs函数的功能，多条件取最小值，条件一，编号相同，条件二，<>"已处理"的项目（或者为空）。根据这两个条件，提取有效期的最小值，备注“已处理”的条目跳过，不提取与之对应的日期。

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

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

最佳答案