DDimok » 03.03.2005 (Чт) 20:47
Спасибо, код макроса я уже сам слабал -
если потребуется - вот:
Sub hitroSort()
' сортирует лист по столбцу с данными типа 1:2, 2:16, 2:1:56, 3:6:2:9, ...
Dim vOldRow As Integer, vOldCol As Integer, vNewCol As Integer, vRow As Integer
Dim cTemp As String, i As Integer
vOldCol = Selection.Rows.Column ' колонка на которой стоим
vOldRow = Selection.Rows.Row ' строка на которой стоим
vNewCol = vOldCol + 1
Columns(vNewCol).Select
Selection.Insert Shift:=xlToRight ' вставить новую колонку
Selection.NumberFormat = "0" ' формат данных на ней - числа
Cells(vOldRow, vNewCol).Select
vRow = 0
' пройтись от первой строки до "первой пустой" строки
Do
vRow = vRow + 1
cTemp = Cells(vRow, vOldCol)
If cTemp = Empty Then
Exit Do
End If
' найти последний символ двоеточия
i = InStrRev(cTemp, ":")
If i > 0 Then
cTemp = Mid(cTemp, i + 1)
End If
Cells(vRow, vNewCol) = cTemp
Loop
''''''''''''''''''''''''''''''''''''''
' выделение всего и сортировка
Cells.Select
Selection.Sort _
Key1:=Range(Cells(1, vNewCol), Cells(1, vNewCol)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' DataOption1:=xlSortTextAsNumbers '''' это XP-шная фича
Cells(vOldRow, vOldCol).Select
' удалить вспомогательную колонку
Columns(vNewCol).Select
Selection.Delete Shift:=xlToLeft
Cells(vOldRow, vOldCol).Select
Exit Sub
End Sub
Дмитрий