Добрый день форумчане!
Необходимо реализовать вставку данных на лист Excel из формы.
В столбец A формы введены даты. Необходимо найти нужную дату и напротив (столбец B,C, и т.д.) нее вывести данные с формы. Реализовал 2-я вариантами, но при Варианте 1, вставка данных происходит в строки 42......, а при варианте 2, кривой выход из Loop'a, может кто подскажет. Сам не программист, так что, sorry, если вопрос тупой.
Пример прикрепил [ATTACH]2163[/ATTACH]
P.s. по хорошему программа должна находить дату , после чего добавлять пустую строку, ставить в столбец А дату, в столбцы B,C,D-данные.
Запутался
Модератор: Naeel Maqsudov
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Вариант I (при желании, свойства .Value и .Caption можно не указывать, ибо они дефолтные)
Код: Выделить всё
Private Sub CommandButton1_Click()
Dim iText$, iCell As Range
iText = TextBox1.Value
If IsDate(iText) = True Then
Set iCell = ActiveWorkbook.Worksheets(1).Columns("A").Find(CDate(iText), , xlValues, xlWhole)
If Not iCell Is Nothing Then
iCell(1, 2).Value = Label1.Caption
iCell(1, 3).Value = Label2.Caption
iCell(1, 4).Value = Label3.Caption
Else
TextBox1.Value = "Дата не найдена"
End If
End If
End Sub
pashulka писал(а):Вариант I (при желании, свойства .Value и .Caption можно не указывать, ибо они дефолтные)
Код: Выделить всё
Private Sub CommandButton1_Click() Dim iText$, iCell As Range iText = TextBox1.Value If IsDate(iText) = True Then Set iCell = ActiveWorkbook.Worksheets(1).Columns("A").Find(CDate(iText), , xlValues, xlWhole) If Not iCell Is Nothing Then iCell(1, 2).Value = Label1.Caption iCell(1, 3).Value = Label2.Caption iCell(1, 4).Value = Label3.Caption Else TextBox1.Value = "Дата не найдена" End If End If End Sub
pashulka спасибо большое, все как нода, но есть одно НО!
Есть маленькая проблема по моей программе. Если даты нет в столбце A, то программа должна вставлять данные (по хорошему между датами, например в столбце A идут даты 15.....17, а дата у нас в TextBox1, например 16, соответственно программа вставляет строчу между этими датами на лист, НО ЭТО КАК Я СКАЗАЛ ЭТО В ЛУЧШЕМ ВАРИАНТЕ, т.к. дня меня это пока трудно осуществимо), пока, хотя бы в конец столбца дат (столбец A). Соответственно вместо:
TextBox1.Value = "Дата не найдена"
должна быть вставка на лист в последнюю строку данных Label с формы. Т.е. как я понимаю, если даты нет, то (В ЛУЧШЕМ ВАРИАНТЕ) должно быть Find ближайшей даты и вставка. Поэтому код кривожQ#$@ско поменял, но понятно, что ничего не получиться из за данной строки кода (реализую вставку в конец столбца A):
i = Val(Cells(Rows.Count, 1).End(xlUp).Row) + 1
, на какой поменять???
Dim iText$, iCell As Range
iText = TextBox1.Value
If IsDate(iText) = True Then
Set iCell = ActiveWorkbook.Worksheets(1).Columns("A").Find(CDate(iText), , xlValues, xlWhole)
If Not iCell Is Nothing Then
Else
i = Val(Cells(Rows.Count, 1).End(xlUp).Row) + 1
End If
iCell(1, 2).Value = Label1.Caption
iCell(1, 3).Value = Label2.Caption
iCell(1, 4).Value = Label3.Caption
End If
pashulka писал(а):Вариант I (при желании, свойства .Value и .Caption можно не указывать, ибо они дефолтные)
Код: Выделить всё
Private Sub CommandButton1_Click() Dim iText$, iCell As Range iText = TextBox1.Value If IsDate(iText) = True Then Set iCell = ActiveWorkbook.Worksheets(1).Columns("A").Find(CDate(iText), , xlValues, xlWhole) If Not iCell Is Nothing Then iCell(1, 2).Value = Label1.Caption iCell(1, 3).Value = Label2.Caption iCell(1, 4).Value = Label3.Caption Else TextBox1.Value = "Дата не найдена" End If End If End Sub
pashulka спасибо большое!
Но есть маленькая проблема по моей программе. Если даты нет в столбце A, то программа должна вставлять данные (по хорошему между датами, например в столбце A идут даты 15.....17, а дата у нас в TextBox1, например 16, соответственно программа вставляет строчу между этими датами, НО ЭТО КАК Я СКАЗАЛ ЭТО В ЛУЧШЕМ ВАРИАНТЕ, т.к. дня меня это пока трудно осуществимо), пока, хотя бы в конец столбца дат (столбец A). Соответственно вместо:
TextBox1.Value = "Дата не найдена"
должна быть вставка на лист в последнюю строку данных Label с формы. Т.е. как я понимаю, если даты нет, то (В ЛЮЧШЕМ ВАРИАНТЕ) должно быть Find ближайшей даты и вставка. Поэтому код кривожQ#$@ско поменял, но понятно, что ничего не получиться из за данной строки кода (реализую вставку в конец столбца A):
i = Val(Cells(Rows.Count, 1).End(xlUp).Row) + 1
, на какой поменять???
Dim iText$, iCell As Range
iText = TextBox1.Value
If IsDate(iText) = True Then
Set iCell = ActiveWorkbook.Worksheets(1).Columns("A").Find(CDate(iText), , xlValues, xlWhole)
If Not iCell Is Nothing Then
Else
i = Val(Cells(Rows.Count, 1).End(xlUp).Row) + 1
End If
iCell(1, 2).Value = Label1.Caption
iCell(1, 3).Value = Label2.Caption
iCell(1, 4).Value = Label3.Caption
End If
Можно расписать всё подробно, т.е.
P.S. Если, в случае отсутствия искомой даты, ввести в столбец A эту дату, а затем отсортировать столбцы A-D, то можно будет обойтись без поиска ближайших присутствующих дат.
Код: Выделить всё
Private Sub CommandButton1_Click()
Dim iSource As Range, iCell As Range, iText$, iRow&
Set iSource = ActiveWorkbook.Worksheets(1).Range("A:A") '.Columns("A").Cells
iText = TextBox1.Value
If IsDate(iText) = True Then
Set iCell = iSource.Find(CDate(iText), , xlValues, xlWhole)
If Not iCell Is Nothing Then
iRow = iCell.Row
Else
iRow = iSource(iSource.Count).End(xlUp).Row + 1
End If
End If
iSource(iRow, 2).Value = Label1.Caption
iSource(iRow, 3).Value = Label2.Caption
iSource(iRow, 4).Value = Label3.Caption
End Sub
pashulka писал(а):Можно расписать всё подробно, т.е.
P.S. Если, в случае отсутствия искомой даты, ввести в столбец A эту дату, а затем отсортировать столбцы A-D, то можно будет обойтись без поиска ближайших присутствующих дат.Код: Выделить всё
Private Sub CommandButton1_Click() Dim iSource As Range, iCell As Range, iText$, iRow& Set iSource = ActiveWorkbook.Worksheets(1).Range("A:A") '.Columns("A").Cells iText = TextBox1.Value If IsDate(iText) = True Then Set iCell = iSource.Find(CDate(iText), , xlValues, xlWhole) If Not iCell Is Nothing Then iRow = iCell.Row Else iRow = iSource(iSource.Count).End(xlUp).Row + 1 End If End If iSource(iRow, 2).Value = Label1.Caption iSource(iRow, 3).Value = Label2.Caption iSource(iRow, 4).Value = Label3.Caption End Sub
Спасибо
То что надо pashulka!!!! ОГРОМНОЕ СПАСИБО ЗА ПОМОЩЬ!!!
Практически все подогнал! Последнее что делаю, смещаю одну строку вниз, вставляю данные в пустую строку и выделяю цветом. Правильно ли сделал или можно как-то по другому записать?!
If IsDate(iText) = True Then
Set iCell = iSource.Find(CDate(iText), , xlValues, xlWhole)
If Not iCell Is Nothing Then
iRow = iCell.Row
Rows(iRow & ":" & iRow).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A" & iRow & ":" & "L" & iRow).Interior.ColorIndex = 6
Три красные строчки, при желании, можно заменить, например, на :
Код: Выделить всё
iCell.EntireRow.Insert 'xlDown, xlFormatFromLeftOrAbove
iCell(0).Resize(, 12).Interior.ColorIndex = 6
'iCell.Offset(-1).Resize(, 12).Interior.Color = vbYellow