Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматизация сортировки по столбцам
 
#1
18.09.2017 12:01:26
Здравствуйте, уважаемые!
Подскажите пожалуйста код макроса, чтобы отсортировать значения по не пустому признаку по столбцам. По сути, нужно убрать пустоты. С задачей справляется сортировка, если в параметрах выбрать "по столбцам диапазона", но она работает в рамках выделенной строки, а таких строк около 100 тыс.  Есть пример (во вложении).
 
 
 
#2
18.09.2017 12:09:02
Такое можно рекодером записать:
Код
Dim lstr&
lstr = Cells(Rows.count, 2).End(xlUp).row
Range("B2:G" & lstr).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

1. Определяется последняя строка.
2. В диапазоне "B2:Gn" выделяются пустые ячейки ' n - последняя строка
3. Удаляются пустые ячейки со сдвигом влево.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#3
18.09.2017 12:20:58
Спасибо!
Изменено: bss17 - 18.09.2017 13:49:58
 
 
 
#4
18.09.2017 12:30:31
Цитата
Владимир написал:
1. Определяется последняя строка.
Похоже вот с этим еще проблема. Пытаюсь масштабировать на массив данных из 73 тыс строк. Начинается он все так же с B2, Заканчивается на BE73078. Внес корректировку в код диапазона. Макрос выдал ошибку, видимо с определением последней строки проблема. В чем суть строчки "lstr = Cells(Rows.count, 2).End(xlUp).row"?
 
 
 
#5
18.09.2017 12:36:53
1.Rows.count - количество строк, откуда начинаем отсчёт.
2.End(xlUp) - это движение вверх до первой не пустой строки.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
 
 
#6
18.09.2017 13:33:47
А можно как-то вручную ввести значения, если они мне известны? Выходят ошибки, не могу запустить (
Изменено: bss17 - 18.09.2017 13:35:14
 
 
 
#7
18.09.2017 13:34:41
Владимир, возможно ошибка потому что первая строка (B2) у меня пустые.
 
 
 
#8
18.09.2017 13:47:12
Код
    Dim lr&
    lr = [b:g].Find("*", [b1], xlFormulas, 1, 1, 2).Row
Я сам - дурнее всякого примера! ...
 
 
 
#9
18.09.2017 13:50:44
kuklp, расскажите, что сделать, чтобы сработал механизм? Выделить интересующий диапазон?
 
 
 
#10
18.09.2017 13:50:57
Цитата
bss17 написал:
массив данных из 73 тыс строк
тут только циклом наверное, или по частям. 8100 областей ограничение, если не ошибаюсь.
Я сам - дурнее всякого примера! ...
 
 
 
#11
18.09.2017 13:56:07
Цитата
bss17 написал:
расскажите, что сделать
накидайте пример хотя бы на 300 строк, напишу кусками. В реальных данных тоже 4 столбца?
Я сам - дурнее всякого примера! ...
 
 
 
#12
18.09.2017 14:02:37
Не проверял:
Код
Public Sub www()
    Dim lr&, i&
    lr = [b:g].Find("*", [b1], xlFormulas, 1, 1, 2).Row
    On Error Resume Next
    For i = 2 To lr Step 2000
        Cells(i, 2).Resize(2000, 4).SpecialCells(4).Delete xlToLeft
    Next
End Sub
Изменено: kuklp - 18.09.2017 14:04:07
Я сам - дурнее всякого примера! ...
 
 
 
#13
18.09.2017 14:08:29
kuklp, во вложении пример побольше.
 
 
 
#14
18.09.2017 14:10:17
Макрос из № 12 не подошел?
Я сам - дурнее всякого примера! ...
 
 
 
#15
18.09.2017 14:18:19
Макрос из № 12 оставляет пробелы.
 
 
 
#16
18.09.2017 14:21:30
В первом примере было всего 6 столбцов, поэтому и оставляет. Будет медленно. Быстрей сделать на массиве, но мне некогда.
Код
Public Sub www()
    Dim lr&, i&
    lr = [b:bc].Find("*", [b1], xlFormulas, 1, 1, 2).Row
    On Error Resume Next
    Application.ScreenUpdating = 0
    For i = 2 To lr Step 8000 / 54
        Cells(i, 2).Resize(2000, 55).SpecialCells(4).Delete xlToLeft
    Next
    Application.ScreenUpdating = -1
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#17
18.09.2017 14:34:55
kuklp,теперь он затирает все (

блин, вот вроде с кодом знаком, но то, что пишется в Макросах Excel, вообще не могу понять, чтобы хоть как-то настроить.
 
 
 
#18
18.09.2017 14:40:51
Сочувствую. У меня не затирает.
Я сам - дурнее всякого примера! ...
 
 
 
#19
18.09.2017 14:47:35
kuklp, а выделить нужно диапазон? Или не важно? Не важно где курсор?
 
 
 
#20
18.09.2017 14:49:46
Не важно. Важно чтоб структура данных была как в примере.
Я сам - дурнее всякого примера! ...
 
 
 
#21
18.09.2017 15:13:33
kuklp,открываю тот же документ, что и прикладывал к примерам, макрос стирает все данные, кроме самой первой строчке с цифрами. Вижу у Вас на скрине "0" в столбце A1. Может еще есть какие-то изменения?  
 
 
 
#22
18.09.2017 17:25:09
Уезжал на пляж. Попробуйте так:
Код
Public Sub www()
    Dim lr&, i&, n&
    lr = [b:bc].Find("*", [b1], xlFormulas, 1, 1, 2).Row
    On Error Resume Next
    Application.ScreenUpdating = 0
    n = 8000 \ 54    '54 - к-во столбцов
    For i = 2 To lr Step n
        Cells(i, 2).Resize(n, 54).SpecialCells(4).Delete xlToLeft
    Next
    Application.ScreenUpdating = -1
End Sub
Изменено: kuklp - 18.09.2017 17:31:21 (Ваш файл. Кнопку щелкнуть осилите? :))
Я сам - дурнее всякого примера! ...
 
 
 
#23
18.09.2017 17:40:03
kuklp,Отлично! Спасибо огромное за помощь!
 
 
 
#24
18.09.2017 17:50:37
А так будет пошустрей:
Код
Public Sub www1()
    Dim lr&, i&, n&, m&, a, j&
    lr = [b:bc].Find("*", [b1], xlFormulas, 1, 1, 2).Row
    a = Range("b2:bc" & lr).Value
    For i = 1 To UBound(a)
        m = 0
        For j = 1 To 54
            If Len(a(i, j)) Then m = m + 1: a(i, m) = a(i, j): a(i, j) = IIf(m = j, a(i, j), Empty)
        Next
    Next
    [b2].Resize(UBound(a), 54).Value = a
End Sub
Изменено: kuklp - 18.09.2017 18:01:19
Я сам - дурнее всякого примера! ...
 
 
 
Страницы: 1
Читают тему
Наверх