Запутался

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
Dark
Сообщения: 63
Зарегистрирован: 23 июл 2008, 23:21

15 янв 2015, 12:44

Добрый день форумчане!
Необходимо реализовать вставку данных на лист Excel из формы.
В столбец A формы введены даты. Необходимо найти нужную дату и напротив (столбец B,C, и т.д.) нее вывести данные с формы. Реализовал 2-я вариантами, но при Варианте 1, вставка данных происходит в строки 42......, а при варианте 2, кривой выход из Loop'a, может кто подскажет. Сам не программист, так что, sorry, если вопрос тупой.
Пример прикрепил [ATTACH]2163[/ATTACH]

P.s. по хорошему программа должна находить дату , после чего добавлять пустую строку, ставить в столбец А дату, в столбцы B,C,D-данные.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
pashulka
Сообщения: 831
Зарегистрирован: 24 ноя 2004, 03:46
Контактная информация:

15 янв 2015, 20:02

Вариант 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
Dark
Сообщения: 63
Зарегистрирован: 23 июл 2008, 23:21

16 янв 2015, 12:34

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
:confused:
, на какой поменять???

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
Dark
Сообщения: 63
Зарегистрирован: 23 июл 2008, 23:21

16 янв 2015, 13:10

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
:confused:
, на какой поменять???

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
Сообщения: 831
Зарегистрирован: 24 ноя 2004, 03:46
Контактная информация:

16 янв 2015, 19:48

Можно расписать всё подробно, т.е.

Код: Выделить всё

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
P.S. Если, в случае отсутствия искомой даты, ввести в столбец A эту дату, а затем отсортировать столбцы A-D, то можно будет обойтись без поиска ближайших присутствующих дат.
Dark
Сообщения: 63
Зарегистрирован: 23 июл 2008, 23:21

19 янв 2015, 17:57

pashulka писал(а):Можно расписать всё подробно, т.е.

Код: Выделить всё

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
P.S. Если, в случае отсутствия искомой даты, ввести в столбец A эту дату, а затем отсортировать столбцы A-D, то можно будет обойтись без поиска ближайших присутствующих дат.

Спасибо

То что надо pashulka!!!! ОГРОМНОЕ СПАСИБО ЗА ПОМОЩЬ!!! :rolleyes:
Практически все подогнал! Последнее что делаю, смещаю одну строку вниз, вставляю данные в пустую строку и выделяю цветом. Правильно ли сделал или можно как-то по другому записать?!

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
pashulka
Сообщения: 831
Зарегистрирован: 24 ноя 2004, 03:46
Контактная информация:

19 янв 2015, 19:46

Три красные строчки, при желании, можно заменить, например, на :

Код: Выделить всё

iCell.EntireRow.Insert 'xlDown, xlFormatFromLeftOrAbove
iCell(0).Resize(, 12).Interior.ColorIndex = 6

'iCell.Offset(-1).Resize(, 12).Interior.Color = vbYellow
Ответить