снегурка,
ниже под второй пример, но обратите внимание что у вас не даты на листе "Worksheet", а текст, соответсвенно не будет максимальаня дата проставляться вв листе 3 для того что бы считалась максимальная - приведите даты в порядок можно так: написать число 1 в любой ячейке и скопировать ее - затем выделить ячейки с датами - специальная вставка - умножить и тогда все будет работать....
Код |
---|
Sub dati()
Dim i As Double, k As Double, n As Double
Dim ilastrow As Integer, ilastrow2 As Integer, ilastcol As Integer, ilastcol2 As Integer
Application.ScreenUpdating = False
Worksheets("Лист3").Cells(3, 2).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
ilastrow = Worksheets("Лист3").Cells(Rows.Count, 1).End(xlUp).Row
For n = 2 To ilastrow Step 1
ilastrow2 = Worksheets("Worksheet").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ilastrow2 Step 1
ilastcol = Worksheets("Worksheet").Cells(i, Columns.Count).End(xlToLeft).Column
For k = 3 To ilastcol Step 1
ilastcol2 = Worksheets("Лист3").Cells(n, Columns.Count).End(xlToLeft).Column + 1
If ilastcol2 = 2 Then
ilastcol2 = ilastcol2 + 1
Else
ilastcol2 = ilastcol2
End If
If Worksheets("Worksheet").Cells(i, k) = Worksheets("Лист3").Cells(n, 1) Then
Worksheets("Лист3").Cells(n, ilastcol2) = Worksheets("Worksheet").Cells(i, 2)
End If
Next k
Next i
If WorksheetFunction.Count(Range(Cells(n, 3), Cells(n, ilastcol2))) > 0 Then
Worksheets("Лист3").Cells(n, 2) = WorksheetFunction.Max(Range(Cells(n, 3), Cells(n, ilastcol2)))
Else
Worksheets("Лист3").Cells(n, 2) = ""
End If
Next n
Application.ScreenUpdating = True
End Sub |