Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Заполнить пустые ячейки значениями из верхних
 
Доброго времени суток, Планетяне!
Вроде как удалось найти оптимальное решение этого популярного вопроса  ;)

Итак - в чём были проблемы:
1. Метод заполнения блоками через формулу, заменяемую на значения, не сработает в текстовых ячейках, т.к. в текстовых ячейках формулы не живут)))
2. Метод выделения пустых ячеек xlCellTypeBlanks некорректно себя ведёт при выделении 1 пустой/непустой ячейки

Ссответственно, добавил проверки с перестраховкой и мэсэджами (подскажут, что не так). Так как использовал Offset, то и в манипуляциях с форматами ячеек отпала необходимость — заполняет и текст и дату, не трогая существующие форматы.

А вот и вся коллекция

Спасибо всем местным мастерам за помощь и подсказки!  ;)
Изменено: Jack Famous - 10.10.2017 16:41:47
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Пример где? С тем, что не получается.
Я сам - дурнее всякого примера! ...
 
в теме написано "заполнить пустые значениями из верхних"
макрос именно это и делает в отмеченном диапазоне
а что нужно-то?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
kuklp, по макросу попыток нет - сейчас попробую что-то изобразить… :(
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Раз уж там все равно цикл макросом, то зачем там формулы? Ненужные телодвижения. Для столбца А:

Код
    For Each a In Intersect(UsedRange, [a:a]).SpecialCells(4).Areas
        a.Value = a(1)(0)
    Next
Изменено: kuklp - 14.10.2016 11:19:13
Я сам - дурнее всякого примера! ...
 
Ігор Гончаренко, нужно устранить проблемы…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
kuklp, а для Selection просто заменить UsedRange, [a:a]?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
А попробовать?
Я сам - дурнее всякого примера! ...
 
kuklp, вот так выдаёт ошибку
Код
Sub FillEmptyFromAbove()

For Each a In Intersect(Selection).SpecialCells(4).Areas
        a.Value = a(1)(0)
    Next
    
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Код
For Each a In Selection....
Я сам - дурнее всякого примера! ...
 
kuklp, спасибо)) всё заполняет значениями из левой верхней ячейки  :(
а вот так вообще ничего не заполняет (правда, и ошибку не выдаёт)
Код
Sub FillEmptyFromAbove()

For Each a In Selection.SpecialCells(4).Areas
        a.Value = a.Offset(-1, 0)
    Next
    
End Sub
Изменено: Jack Famous - 14.10.2016 11:33:43
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Бог с ней, с 1 ячейкой - буду просто вставлять значениями в таком случае… А вот с текстовым форматом - это реально проблема. Исходный макрос в принципе всё круто делает, только из-за того, что он сначала формулы прописывает - не работает с текстовыми форматами
Изменено: Jack Famous - 14.10.2016 11:40:50
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Цитата
Jack Famous написал:
буду просто вставлять значениями
Бог в помощь.
Код
Public Sub www()
    On Error GoTo ErrorHandler
    Dim a As Range, c As Range
    For Each c In UsedRange.Columns
        For Each a In Intersect(UsedRange, c).SpecialCells(4).Areas
            a.Value = a(1)(0)
        Next: Next
    Exit Sub
ErrorHandler:
    MsgBox Error, vbExclamation + vbOKOnly
End Sub
Я сам - дурнее всякого примера! ...
 
kuklp, ошибка object required  :( прикрепил пример с основной проблемой
Изменено: Jack Famous - 14.10.2016 11:54:16
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Это в модуль листа надо.
Я сам - дурнее всякого примера! ...
 
kuklp, простите, а что нужно сделать, чтобы его можно было из личной надстройки запускать? Из листа работает как положено - спасибо большое)))
Изменено: Jack Famous - 14.10.2016 11:56:22
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Указать полный путь к диапазону:
Код
...
    For Each c In ActiveWorkbook.ActiveSheet.UsedRange.Columns
        For Each a In Intersect(ActiveWorkbook.ActiveSheet.UsedRange, c).SpecialCells(4).Areas
...
Я сам - дурнее всякого примера! ...
 
kuklp, большое вам спасибо! Всё отлично работает  :D
Я-то думал, что цикла с Offset хватит…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Цитата
А вот с текстовым форматом - это реально проблема.
Код
        
'заполнение пустых ячеек данными из вышестоящей ячейки
 With .Range("A1:E" & iLastRow)
   .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
   .Value = .Value
 End With

 
Kuzmich, так тоже самое… Вставляет вместо самого текста "=R[-1]C"
Изменено: Jack Famous - 14.10.2016 12:11:48
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Не могу посмотреть ваш файл, но строка заменяет формулу на текст
Код
.Value = .Value
 
Kuzmich, дак да)))) но он не может формулой посчитать, т.к. формат текстовый и менять его нельзя из-за номеров типа "0002569". Я проверил ваш макрос - результат точно такой же, как и в исходном
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Jack Famous
А, если так попробовать
Код
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   On Error Resume Next
   With Range("A2:A" & iLastRow).SpecialCells(xlCellTypeBlanks)
      .NumberFormat = "General"
      .FormulaR1C1 = "=R[-1]C"
      .Value = .Value
   End With
 
Kuzmich, сделал так (для Selection) - заполнило значениями из верхней левой или ошибками  :(
Я очень мало понимаю в VBA, но думаю, что преобразование форматов в общий и обратно не поможет, т.к. при преобразовании в общий у артикулов с нулями в начале типа "00005987" оторвёт ведущие нули
Код
Sub www()
   On Error Resume Next
   With Selection.SpecialCells(xlCellTypeBlanks)
      .NumberFormat = "General"
      .FormulaR1C1 = "=R[-1]C"
      .Value = .Value
   End With
End Sub
Изменено: Jack Famous - 14.10.2016 17:00:05
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Вот так попробуйте
Код
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, 4).End(xlUp).Row
   On Error Resume Next
   With Range("A2:D" & iLastRow)
     With .SpecialCells(xlCellTypeBlanks)
      .NumberFormat = "General"
      .FormulaR1C1 = "=R[-1]C"
     End With
      .Value = .Value
   End With
 
Kuzmich, Работает из личной надстройки, но странно)))))) Если выделить диапазон ТОЛЬКО с текстовыми форматами, то всё гуд. А если в диапазоне присутствует общий, то во вставленном формат общий и обрезаны (как следствие) нули
kuklp, попробовал из личной надстройки запустить в другом документе - ошибку выдаёт  :(
Изменено: Jack Famous - 14.10.2016 17:35:06
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
 
Доброго вечера, Планетяне!
Подниму-ка свою тему старую из закромов, т.к. проблему эту полностью решил, вроде как  :)
Обновил шапку
Изменено: Jack Famous - 10.10.2017 16:39:43
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) [►Кошелёк и контакты◄]
Страницы: 1
Читают тему (гостей: 1)
Наверх