Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA_вставка значения в первую пустую ячейку диапазона
 
Здравствуйте!
Суть вопроса, есть некий диапазон пусть будет:
Set aR = Range("I10:I20")
собственно нужно заполнить это диапазон значениями. Но каждое новое значение должно вставляться в первую пустую строчку. Если диапазон заполнен при попытке туда что то записать должна выводиться ошибка. Помогите пожалуйста :)
Изменено: Сергей Ко - 4 Дек 2019 11:22:46
 
Сергей Ко, здравствуйте!
Цитата
Сергей Ко: есть некий диапазон Range("I10:I20") — нужно заполнить это диапазон значениями
Код
Range("I10:I20").Value2="Значение"
или руками выделить диапазон, набрать значение и нажать "Ctrl+Enter"

Циклом с учётом заполненных:
Код
Sub t ()
Dim cl as Range
   For Each cl In Range("I10:I20")
      If Len(cl)=0 Then cl.Value2="значение"
   Next cl
End Sub
Изменено: Jack Famous - 4 Дек 2019 11:28:02
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
Код ? 1Range("I10:I20").Value2="Значение"или руками выделить диапазон, набрать значение и нажать "Ctrl+Enter"
Я наверно не правильно выразился, в диапазон всегда вставляется новое значение.
Например вот есть код:
Код
On Error Resume Next  
Columns(1).SpecialCells(xlCellTypeBlanks)(1) = TextBox1.Value  
If Err Then Cells(Rows.Count, 1).End(xlUp).Offset(1) = TextBox1.Value  
Err.Clear 

этот код будет вставлять значение введеные пользователем в столбец А, начиная с первой строки, если строка не пустая, он ее пропустит и впишет значение в следующую пустую. Мне нужно тоже самое но для конкретного диапазона, и что бы за рамки этого диапазона нельзя было выйти.  
Изменено: Сергей Ко - 4 Дек 2019 11:43:33
 
Цитата
Сергей Ко: Я наверно не правильно выразился, в диапазон всегда вставляется новое значение
а я вот что-то не припомню, чтобы вы давали какой-то список значений для примера или файл…
Принцип я вам показал - пробуйте
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Сергей Ко, посмотрите, как выглядит код у Джека, и как у Вас. Оформляйте правильно.
 
Цитата
Jack Famous написал:
а я вот что-то не припомню, чтобы вы давали какой-то список значений для примера или файл…Принцип я вам показал - пробуйте
Вот файл с примером. Мне нужно тоже самое только в рамках  Range("I10:I20"). Что бы данные не перезаписывались, и при отсутствии пустой ячейки выводилась ошибка.
 
Сергей Ко
Код ТС'а
никакого набора значений у вас нет, есть только значение в текстбоксе, а значит нужно почти тоже самое, что я показал в #2
Код
On Error Resume Next  
Range("I10:I20").SpecialCells(xlCellTypeBlanks).Value2 = TextBox1.Value 
If Err Then Err.Clear: MsgBox "НЕТ ПУСТЫХ"
On Error GoTo 0
Изменено: Jack Famous - 4 Дек 2019 12:02:30
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Код не работает.
Набора значений и не должно быть. Так как значение вводится в текстбокс
 
Цитата
Сергей Ко: Данный код не работает
а по-другому попробовать? Совсем не хотите думать)))
Код
Private Sub Up_Click()
Dim cl As Range, txt$, flag As Boolean

txt = TextBox1.Value

    For Each cl In Range("I10:I20")
        If Len(cl) = 0 Then
            flag = True
            cl.Value2 = txt
            Exit For
        End If
    Next cl

If Not flag Then MsgBox "НЕТ ПУСТЫХ", vbCritical, "ERROR"
End Sub
Изменено: Jack Famous - 4 Дек 2019 12:14:14
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Думать то я хочу. Я сделал следующем образом:
Код
On Error Resume Next
Range("I10:I20").SpecialCells(xlCellTypeBlanks)(1) = TextBox1.Value
If Err Then Cells(Rows.Count, 1).End(xlUp).Offset(1) = TextBox1.Value
Err.Clear: MsgBox "Ошибка"
Этот код отрабатывает как надо, НО когда диапазон кончается, выводится сообщение, а последнее введеные данные записываются в ячейку А2. Почему это происходит.
Изменено: Сергей Ко - 6 Дек 2019 09:59:30
 
Цитата
Сергей Ко: Почему это происходит
потому что вы совершенно не знаете, что пишете, очевидно, т.к. для человека самостоятельно пишущего код, этого вопроса бы не возникло (вы сами в коде написали это сделать)
Этот вопрос не по теме, так что создавайте новую, если хотите разобраться…
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous, Спасибо за помощь
 
Сергей Ко, пожалуйста  :)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous,
Подскажи пожалуйста еще:
Код
On Error Resume Next
Range("I10:I20").SpecialCells(xlCellTypeBlanks)(1) = TextBox1.Value
If Err Then Cells(Rows.Count).End(xlUp).Offset(1) = TextBox1.Value
Err.Clear: MsgBox "Ошибка"

Err.Clear: MsgBox "Ошибка" - Выводит сообщение при каждом вводе данных, как мне вывести сообщение только при заполненом диапазоне?  
Изменено: Сергей Ко - 4 Дек 2019 13:38:22
 
Сергей Ко, у нас на форуме к незнакомым людям принято обращаться на Вы.
Попробуйте такой макрос:
Код
Sub Macro1()
Dim FreeRow As Long, aR As Range
    Set aR = Range("I10:I20")
    With aR
        FreeRow = .Cells(20, 1).End(xlUp).Row + 1
        If FreeRow < 10 Then FreeRow = 10
        If FreeRow < 21 Then
            .Cells(FreeRow - .Rows.Count + 2) = "Значение"
        Else
            MsgBox "Диапазон уже полностью заполнен", 48, "Ашыпка!"
        End If
    End With
End Sub
 
Сергей Ко, в #9 я вам дал полностью рабочий макрос. Получается, благодарность за помощь была сарказмом?…
Цитата
Сергей Ко : Подскажите пожалуйста еще
как сейчас
как надо (один из вариантов)
то же, но короче
ещё лучше
UPD: метод SpecialCells(xlCellTypeBlanks) не надёжен для решения данного вопроса в силу свей специфики. Рекомендую код из #9
Изменено: Jack Famous - 5 Дек 2019 09:15:47
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
я вам дал полностью рабочий макрос. Получается, благодарность за помощь была сарказмом?…
Нет ни какого сарказма. Ваш макрос рабочий,  просто интересно стало почему так происходит :) копаю литературу, ну и попутно спросил у Вас :)
 
Цитата
Jack Famous написал:
Код ? 12345Sub t ()On Error Resume NextRange("I10:I20").SpecialCells(xlCellTypeBlanks)(1).Value2=TextBox1.ValueIf Err Then MsgBox "ОшибкаEnd Sub
Хм.. код интересный короткий, но почему то у меня всегда выдает ошибку, даже если диапазон пустой.
 
Цитата
Сергей Ко: всегда выдает ошибку, даже если диапазон пустой
вот что значит "не тестировал"  :sceptic:

Итак: проблема в особенности работы метода SpecialCells(xlCellTypeBlanks), а конкретно в том, что этот метод не просто выделяет пустые, но ещё и ограничен рабочей областью листа (как я понял по тестам). Иными словами, если бы у вас были какие-либо данные НЕ ЛЕВЕЕ и НЕ ВЫШЕ диапазона "I10:I20" (например значение в ячейке I21 или J20), то он бы отработал корректно.
Данный метод можно воспроизвести руками через F5 — Выделить — Пустые ячейки, результат будет аналогичным.

Поэтому используйте коды из #9 или #15 — они работают по-другому и гораздо более надёжны/универсальны (код Юрия М я не тестил)
Изменено: Jack Famous - 5 Дек 2019 09:17:16
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous, Спасибо большое :) До именно код #9 я ваш использовал, он понятен и рабочий :) SpecialCells(xlCellTypeBlanks) данный метод хорошо использовать если надо работать только со столбцом в целом например "А"
 
Сергей Ко, пожалуйста  :) а что с методом от Юрия М в #15?
Цитата
Сергей Ко: данный метод хорошо использовать если надо работать только со столбцом в целом
нет - если выделите столбец вне рабочей области листа, то также будет ошибка — проверьте
Лично я данный метод в макросах не использую вообще, а вручную — только при необходимости выделить пустые ячейки в столбце умной таблицы (обычно - для удаления потом строк целиком)
Изменено: Jack Famous - 6 Дек 2019 09:15:24
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
Страницы: 1
Читают тему (гостей: 1)
Наверх