Здравствуйте! Суть вопроса, есть некий диапазон пусть будет: Set aR = Range("I10:I20") собственно нужно заполнить это диапазон значениями. Но каждое новое значение должно вставляться в первую пустую строчку. Если диапазон заполнен при попытке туда что то записать должна выводиться ошибка. Помогите пожалуйста
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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
этот код будет вставлять значение введеные пользователем в столбец А, начиная с первой строки, если строка не пустая, он ее пропустит и впишет значение в следующую пустую. Мне нужно тоже самое но для конкретного диапазона, и что бы за рамки этого диапазона нельзя было выйти.
Сергей Ко: Я наверно не правильно выразился, в диапазон всегда вставляется новое значение
а я вот что-то не припомню, чтобы вы давали какой-то список значений для примера или файл… Принцип я вам показал - пробуйте
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: а я вот что-то не припомню, чтобы вы давали какой-то список значений для примера или файл…Принцип я вам показал - пробуйте
Вот файл с примером. Мне нужно тоже самое только в рамках Range("I10:I20"). Что бы данные не перезаписывались, и при отсутствии пустой ячейки выводилась ошибка.
Private Sub Up_Click()
Dim A As String
Dim aR As Range
Dim aR2 As Range
A = "Лист3"
TextBox1.Text = Format(TextBox1.Value, "# ##0,00")
Set aR = Range("I10:I20")
On Error Resume Next
Columns(9).SpecialCells(xlCellTypeBlanks)(1) = TextBox1.Value
If Err Then Cells(Rows.Count, 9).End(xlUp).Offset(1) = TextBox1.Value
Err.Clear
TextBox1.Value = ""
End Sub
никакого набора значений у вас нет, есть только значение в текстбоксе, а значит нужно почти тоже самое, что я показал в #2
Код
On Error Resume Next
Range("I10:I20").SpecialCells(xlCellTypeBlanks).Value2 = TextBox1.Value
If Err Then Err.Clear: MsgBox "НЕТ ПУСТЫХ"
On Error GoTo 0
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
а по-другому попробовать? Совсем не хотите думать)))
Код
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
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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. Почему это происходит.
потому что вы совершенно не знаете, что пишете, очевидно, т.к. для человека самостоятельно пишущего код, этого вопроса бы не возникло (вы сами в коде написали это сделать) Этот вопрос не по теме, так что создавайте новую, если хотите разобраться…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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 "Ошибка" - Выводит сообщение при каждом вводе данных, как мне вывести сообщение только при заполненом диапазоне?
Сергей Ко, у нас на форуме к незнакомым людям принято обращаться на Вы. Попробуйте такой макрос:
Код
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
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 "Ошибка" ' обнуляем ошибку и выводим сообщение об ошибке (то есть пофигу, что там было раньше - просто выводим)
как надо (один из вариантов)
Код
Dim rng as Range
On Error Resume Next
Set rng=Range("I10:I20").SpecialCells(xlCellTypeBlanks) ' создаём диапазон из всех пустых ячеек заданного диапазона
On Error GoTo 0 ' сбрасываем пропуск ошибок
If rng Is Nothing Then ' если наш новый диапазон пустой, то выводим сообщение об ошибке и выходим
Err.Clear ' можно не обнулять (удалить эту строку)
MsgBox "Ошибка
Exit Sub
Else ' если диапазон получился, то вставляем значение из текстбокса в первую ячейку из него
rng(1) = TextBox1.Value
End If
то же, но короче
Код
Dim rng as Range
On Error Resume Next
Set rng=Range("I10:I20").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then rng(1) = TextBox1.Value Else MsgBox "Ошибка
ещё лучше
Код
Sub t ()
On Error Resume Next
Range("I10:I20").SpecialCells(xlCellTypeBlanks)(1).Value2=TextBox1.Value
If Err Then MsgBox "Ошибка
End Sub
UPD: метод SpecialCells(xlCellTypeBlanks) не надёжен для решения данного вопроса в силу свей специфики. Рекомендую код из #9
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Код ? 12345Sub t ()On Error Resume NextRange("I10:I20").SpecialCells(xlCellTypeBlanks)(1).Value2=TextBox1.ValueIf Err Then MsgBox "ОшибкаEnd Sub
Хм.. код интересный короткий, но почему то у меня всегда выдает ошибку, даже если диапазон пустой.
Сергей Ко: всегда выдает ошибку, даже если диапазон пустой
вот что значит "не тестировал"
Итак: проблема в особенности работы метода SpecialCells(xlCellTypeBlanks), а конкретно в том, что этот метод не просто выделяет пустые, но ещё и ограничен рабочей областью листа (как я понял по тестам). Иными словами, если бы у вас были какие-либо данные НЕ ЛЕВЕЕ и НЕ ВЫШЕ диапазона "I10:I20" (например значение в ячейке I21 или J20), то он бы отработал корректно. Данный метод можно воспроизвести руками через F5 — Выделить — Пустые ячейки, результат будет аналогичным.
Поэтому используйте коды из #9 или #15 — они работают по-другому и гораздо более надёжны/универсальны (код Юрия М я не тестил)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Спасибо большое До именно код #9 я ваш использовал, он понятен и рабочий SpecialCells(xlCellTypeBlanks) данный метод хорошо использовать если надо работать только со столбцом в целом например "А"
Сергей Ко: данный метод хорошо использовать если надо работать только со столбцом в целом
нет - если выделите столбец вне рабочей области листа, то также будет ошибка — проверьте Лично я данный метод в макросах не использую вообще, а вручную — только при необходимости выделить пустые ячейки в столбце умной таблицы (обычно - для удаления потом строк целиком)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄