Есть книга с N-ым кол-вом листов. На каждом листе в столбце В выгрузка массива, содержащего время суток в формате h:mm. Кол-во строк на каждом листе различно. Необходимо отсортировать эти массивы по возрастанию, но при условии - если время суток в интервале 00:00 - 00:59, то эти ячейки всегда должны быть внизу массива. Задачу пытаюсь решить примерно таким макросом [vba]
Код
Sub sort() Dim x&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets x = sh.Cells(Rows.Count, 2).End(xlUp).Row For i = 10 To x Step 1 If sh.Cells(i, 2).Value = "00:*" Then sh.Range("B10:B" & i - 1).sort sh.Range("B10:B" & i - 1), Order1:=xlAscending, Header:=xlGuess ElseIf sh.Cells(i, 2).Value <> "00:*" Then sh.Range("B10:B" & x).sort sh.Range("B10:B" & x), Order1:=xlAscending, Header:=xlGuess End If Next i Next End Sub
[/vba]
но условие , нужное мне, не выполняется. Макрос сортирует весь массив по возрастанию. Подозреваю, я неверно задаю условие... Подскажите, в чем может быть ошибка? Что делаю принципиально не так?
Спасибо.
Приветствую всех!
Помогите, пжл, разобраться с макросом.
Есть книга с N-ым кол-вом листов. На каждом листе в столбце В выгрузка массива, содержащего время суток в формате h:mm. Кол-во строк на каждом листе различно. Необходимо отсортировать эти массивы по возрастанию, но при условии - если время суток в интервале 00:00 - 00:59, то эти ячейки всегда должны быть внизу массива. Задачу пытаюсь решить примерно таким макросом [vba]
Код
Sub sort() Dim x&, sh As Worksheet For Each sh In ThisWorkbook.Worksheets x = sh.Cells(Rows.Count, 2).End(xlUp).Row For i = 10 To x Step 1 If sh.Cells(i, 2).Value = "00:*" Then sh.Range("B10:B" & i - 1).sort sh.Range("B10:B" & i - 1), Order1:=xlAscending, Header:=xlGuess ElseIf sh.Cells(i, 2).Value <> "00:*" Then sh.Range("B10:B" & x).sort sh.Range("B10:B" & x), Order1:=xlAscending, Header:=xlGuess End If Next i Next End Sub
[/vba]
но условие , нужное мне, не выполняется. Макрос сортирует весь массив по возрастанию. Подозреваю, я неверно задаю условие... Подскажите, в чем может быть ошибка? Что делаю принципиально не так?
Sub SortNew() Dim sh As Object, c As Object, nRows& For Each sh In ThisWorkbook.Worksheets nRows = sh.Cells(Rows.Count, 2).End(xlUp).Row - 9 With sh.[B10].Resize(nRows, 1) .Replace What:="00:", Replacement:="25::" .sort key1:=sh.[B10], Order1:=xlAscending, Header:=xlGuess End With For Each c In sh.[B10].Resize(nRows, 1).Cells If Left(c.Formula, 4) = "25::" Then c.Formula = "00:" & Mid(c.Formula, 5) Next Next End Sub
[/vba]
Попробуйте что-то вроде такого: [vba]
Код
Sub SortNew() Dim sh As Object, c As Object, nRows& For Each sh In ThisWorkbook.Worksheets nRows = sh.Cells(Rows.Count, 2).End(xlUp).Row - 9 With sh.[B10].Resize(nRows, 1) .Replace What:="00:", Replacement:="25::" .sort key1:=sh.[B10], Order1:=xlAscending, Header:=xlGuess End With For Each c In sh.[B10].Resize(nRows, 1).Cells If Left(c.Formula, 4) = "25::" Then c.Formula = "00:" & Mid(c.Formula, 5) Next Next End Sub