VBA 超一年库存物料统计库存物料最早入库日期（涉及获取过滤后数据最小行号和最大行号）

财务有需要，想要知道入库日期超过一年的物料最早入库的日期是什么时侯。
由于我们没有做批次管理，而入库记录是多次，剩余的库存也不知道是哪几次留存的，只能按先进先出的方法来考虑。原先想通过SQL来写的，但发现难度有点大，但基础数据还是用SQL来写。
首先先过滤出数据，先统计"即时库存数-今年入库数“大于0的物料目录，再按此目录统计出历年入库目录，得到两张表：

物料目录，其中的"库存余量最早入库日期"就要需要统计的目的

这个是物料的入库记录

Sub getdate()

Dim itemid As Variant
Dim kcsl As Long, sl As Long, jssl As Long
Dim count As Long, rowsnum As Long, minrow As Long, maxrow As Long
Dim i As Long, j As Long, k As Long, l As Long
Dim rng As Range, rng1 As Range
Dim rq As Variant

count = ActiveSheet.Range("a" & Rows.count).End(xlUp).Row
rowsnum = Worksheets("sheet1").Range("a" & Rows.count).End(xlUp).Row
Set rng = Worksheets("sheet1").Range("A1:I" & rowsnum)

Application.ScreenUpdating = False '禁止屏幕更新
Application.Interactive = False  '禁止用户干预宏代码的执行

For i = 2 To count
    itemid = ActiveSheet.Range("A" & i)
    kcsl = ActiveSheet.Range("D" & i)
    ' itemid = "2.01.01.001506"
    ' kcsl = 1352
    '
     
    Worksheets("sheet1").Select
  
      If ActiveSheet.FilterMode = True Then
         ActiveSheet.ShowAllData
      End If

    ' 设置排序范围
    rng.Sort Key1:=Range("D1"), Order1:=xlAscending, Key2:=Range("C1"), Order2:=xlAscending, Header:=xlYes
  
    '过滤
    rng.Range("A1").AutoFilter Field:=4, Criteria1:=itemid
    
  
     '获取过滤后数据的最小行号和最大行号
    
    On Error Resume Next
    'l = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.count '获取过滤后的行数
    'If l > 0 Then
    '上面判断行数语句有问题，用下面方法判断ITEMID在表中是否存在

    j = 0
    rq = ""
    Set rng1 = ActiveSheet.Range("D:D").Find(itemid)
    
    If Not rng1 Is Nothing Then
       minrow = 0
       maxrow = 0
       k = 0
        With rng.Offset(1).Resize(rng.Rows.count - 1)
             k = .SpecialCells(xlCellTypeVisible).Rows.count
             If k <> 0 Then
             minrow = .SpecialCells(xlCellTypeVisible)(1).Row
             maxrow = .SpecialCells(xlCellTypeVisible).Rows(.SpecialCells(xlCellTypeVisible).Rows.count).Row
             
    '        Else
    '            MsgBox "没有符合条件的数据！"
            End If
    
    '''        清除筛选条件
    '        rng.Parent.AutoFilterMode = False
        End With
    
    '
        jssl = 0
        
        For j = maxrow To minrow Step -1
         sl = rng.Range("I" & j)
         jssl = jssl + sl
         If jssl >= kcsl Then
           Exit For
         End If
        Next
        rq = rng.Range("C" & j)
     End If
       
    Worksheets("入库超1年").Select
    ActiveSheet.Range("E" & i) = rq'将日期赋到目标单元格
    On Error GoTo 0
Next
Application.ScreenUpdating = True '允许屏幕更新
Application.Interactive = True  '允许用户干预宏代码的执行

End Sub