написал макрос, так оказалось проще. правда реализация ниже по кнопке и не совсем гибкая в некоторых случаях но работает. можно переделать на более красивый вариант Sub Êíîïêà2_Ùåë÷îê() Dim i As Integer, mas As Variant, mas_sort As Variant
If ActiveCell.Value = "Ðîçíèöà" Then r = ActiveCell.Row c = ActiveCell.Column r = r + 1 ActiveSheet.Cells(r, c).Select r_b = r i = 1 Do While ActiveSheet.Cells(r, c).Value <> "Call-öåíòð" And i < 25 r = r + 1 i = i + 1 Loop mas = Range(Cells(r_b, c), Cells(r - 1, c + 19)) mas_sort = CoolSort(mas, 15) Range(Cells(r_b, c), Cells(r - 1, c + 19)) = mas_sort ElseIf ActiveCell.Value = "Îïò" Then r = ActiveCell.Row c = ActiveCell.Column r = r + 1 ActiveSheet.Cells(r, c).Select r_b = r i = 1 Do While ActiveSheet.Cells(r, c).Value <> "Ðîçíèöà" And i < 6 r = r + 1 i = i + 1 Loop mas = Range(Cells(r_b, c), Cells(r - 1, c + 19)) mas_sort = CoolSort(mas, 15) Range(Cells(r_b, c), Cells(r - 1, c + 19)) = mas_sort End If End Sub
//сортировка массива, взято из инета, у меня записей не много по этому производительность сортировки не проверял Function CoolSort(SourceArr As Variant, ByVal N As Integer) As Variant
Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer ReDim tmpArr(UBound(SourceArr, 2)) As Variant Do Until Check Check = True For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1 If Val(SourceArr(iCount, N)) < Val(SourceArr(iCount + 1, N)) Then For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2) tmpArr(jCount) = SourceArr(iCount, jCount) SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount) SourceArr(iCount + 1, jCount) = tmpArr(jCount) Check = False Next End If Next Loop CoolSort = SourceArr End Function
|
|