|
- Sub Demo()
- Dim findArr(), arr(), sht1 As Worksheet, sht2 As Worksheet
- Set sht1 = Sheets("成品入库登记表")
- Set sht2 = Sheets("成品库存统计表")
- arr = sht1.Range("I4:I" & sht1.Range("I4").End(xlDown).Row)
- Dim i As Long, j As Long, maxDate
- maxDate = arr(1, 1)
- For i = LBound(arr) + 1 To UBound(arr)
- If maxDate < arr(i, 1) Then
- maxDate = arr(i, 1)
- End If
- Next i
- j = 1
- For i = LBound(arr) + 1 To UBound(arr)
- If maxDate = arr(i, 1) Then
- ReDim Preserve findArr(1 To j)
- findArr(j) = i + 3
- j = j + 1
- End If
- Next i
- Dim rng As Range, bl As Boolean, firstAddress As String
- For i = LBound(findArr) To UBound(findArr)
- Set rng = sht2.Range("B4:B" & sht2.Range("B4").End(xlDown).Row).Find(sht1.Cells(findArr(i), 2).Value, , , xlWhole)
- If rng Is Nothing Then
- With sht2.Range("B4").End(xlDown)
- .Offset(1, -1).Value = .Offset(0, -1).Value + 1
- .Offset(1, 0).Value = sht1.Cells(findArr(i), 2).Value
- .Offset(1, 1).Value = sht1.Cells(findArr(i), 3).Value
- .Offset(1, 2).Value = sht1.Cells(findArr(i), 4).Value
- .Offset(1, 3).Value = sht1.Cells(findArr(i), 5).Value
- .Offset(1, 4).Value = sht1.Cells(findArr(i), 6).Value
- End With
- Else
- firstAddress = rng.Address
- Do
- If rng.Offset(0, 3).Value = sht1.Cells(findArr(i), 5).Value Then
- rng.Offset(0, 4).Value = rng.Offset(0, 4).Value + sht1.Cells(findArr(i), 6).Value
- bl = True
- Exit Do
- End If
- Set rng = sht2.Range("B4:B" & sht2.Range("B4").End(xlDown).Row).FindNext(rng)
- Loop While Not rng Is Nothing And rng.Address <> firstAddress
- End If
- If Not bl Then
- With sht2.Range("B4").End(xlDown)
- .Offset(1, -1).Value = .Offset(0, -1).Value + 1
- .Offset(1, 0).Value = sht1.Cells(findArr(i), 2).Value
- .Offset(1, 1).Value = sht1.Cells(findArr(i), 3).Value
- .Offset(1, 2).Value = sht1.Cells(findArr(i), 4).Value
- .Offset(1, 3).Value = sht1.Cells(findArr(i), 5).Value
- .Offset(1, 4).Value = sht1.Cells(findArr(i), 6).Value
- End With
- End If
- bl = False
- Next i
- End Sub
复制代码 |
评分
-
2
查看全部评分
-
|