eagl69, можно так (в следующий раз сами пример рисуйте)
Код из файла |
---|
Код |
---|
Option Explicit
'====================================================================================================
Sub FilterArray()
Dim arr, arrNew(), r&, rNew&, c&, t!
t = Timer
arr = Range("A1:L33").Value2
ReDim arrNew(1 To UBound(arr, 1), 1 To UBound(arr, 2))
For r = 1 To UBound(arr, 1)
If arr(r, 5) = "ООО Пупкин" And arr(r, 10) > Date Then
rNew = rNew + 1
For c = 1 To UBound(arr, 2)
arrNew(rNew, c) = arr(r, c)
Next c
End If
Next r
If rNew = 0 Then MsgBox "По выбранным критериям нет данных!", vbExclamation, "ПУСТО": Exit Sub
Application.ScreenUpdating = False
Range("N1").Resize(1, UBound(arrNew, 2)).EntireColumn.Delete
Range("N1").Resize(rNew, UBound(arrNew, 2)).Value2 = arrNew
Application.ScreenUpdating = True
MsgBox "ГОТОВО", vbInformation, Format$(1000 * (Timer - t), "0 мс")
End Sub
'==================================================================================================== |
|