Удаление пустых ячеек с 50000 строк и более

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление пустых ячеек с 50000 строк и более (Макросы/Sub)

djon2012

Дата: Воскресенье, 11.01.2015, 19:13 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 106

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Доброго здравия форумчанам excelworld.ru !!!
Очень нужна Ваша помощь в решении небольшой проблемы. В приведённом примере на Лист3 имеются 30 строк (в реальных условиях их будет 50000 и более ) с числами и пустыми ячейками между ними. Мне нужно удалить пустые ячейки со сдвигом влево в диапазоне E2:CP2 E3:CP3 E4:CP4 и так до тех пор, пока в столбце С и соответственно строке имеется число. Стандартный способ выделение группы ячеек – пустые ячейки на таком количестве строк выполняется ну ооооочень долго, нужен макрос . Помогите пожалуйста если не сложно.
Спасибо!!!

К сообщению приложен файл: 7594819.xlsb (12.9 Kb)

Ответить

RAN

Дата: Воскресенье, 11.01.2015, 19:46 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Любой стандартный способ быстрее любого макроса.

Быть или не быть, вот в чем загвоздка!

Ответить

ShAM

Дата: Воскресенье, 11.01.2015, 20:21 | Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 1347

Репутация: 249 ±

Замечаний: 0% ±

Excel 2010

В продолжение темы: http://www.excelworld.ru/forum/10-15130-1
По второму вопросу я ошибся. Добавьте перед [vba]

Код

End With

[/vba] строку: [vba]

Код

.Range("E" & LastRow2 & ":CP" & LastRow2 + LastRow1 - 1).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

[/vba]

Ответить

nilem

Дата: Воскресенье, 11.01.2015, 21:03 | Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

вот так можно попробовать
[vba]

Код

Sub ertert()
Dim x, y(), i&, j&, k&, mx&
Application.ScreenUpdating = False
With Range("E2:CP" & Cells(Rows.Count, 3).End(xlUp).Row)
     x = .Value
     ReDim y(1 To UBound(x), 1 To UBound(x, 2))
     For i = 1 To UBound(x)
         For j = 1 To UBound(x, 2)
             If Len(x(i, j)) Then k = k + 1: y(i, k) = x(i, j)
         Next j
         If k > mx Then mx = k
         k = 0
     Next i
     .ClearContents
     .Resize(, mx).Value = y()
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

JayBhagavan

Дата: Воскресенье, 11.01.2015, 22:27 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 188

Репутация: 27 ±

Замечаний: 0% ±

Excel 2010

До кучи.[vba]

Код

Sub jjj()
     Application.ScreenUpdating = False
     Set rng = Range([c2], UsedRange.SpecialCells(xlLastCell)).EntireColumn
     For Each clmn In rng
         addr = addr & IIf(WorksheetFunction.CountBlank(clmn) = clmn.Rows.Count, clmn.Column & ",", "")
     Next clmn
     Set rng = Nothing
     addr = Mid(addr, 1, Len(addr) - 1)
     If Len(addr) Then
         a = Split(addr, ",")
         adr = ""
         For i = UBound(a) To LBound(a) Step -1
             Cells(, --a(i)).EntireColumn.Delete Shift:=xlToLeft
         Next i
         Set a = Nothing
     End If
End Sub

[/vba]

Языком ты или построишь жизнь,или разрушишь ее до основания.Думайте что говорите.(с)А.Хакимов

Ответить

djon2012

Дата: Понедельник, 12.01.2015, 08:01 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 106

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Спасибо всем кто откликнулся на помощь! Особенная благодарность ShAM и nilem их варианты более всего подошли. hands

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление пустых ячеек с 50000 строк и более (Макросы/Sub)

Страница 1 из 1
1