Создать две кнопки и прикрепленные к ним формы, для добавления данных

[abdulazizov]

Ребята, нужна помощь, стоит задача сделать макрос, который бы реализовал след требования:
нужно создать две кнопки и прикрепленные к ним формы, для добавления данных, так вот, данные формы добавляют данные на второй лист. Нужна помощь в след вопросах:
1) на второй странице данные заносятся в поля начало (столбец B) и конец рабочего времени (cтольбец C), нужно чтоб разность этих ячеек записывалась в столбец E, соответсвующей строки.
2) Как можно реализовать чтоб при нажатии на кнопку ОК форма закрывалась
3) Как можно сделать чтоб при введении календарных данных на второй форме, данные с такой же датой со второго листа переносились на первый в соответствующие ячейки.
Я устал биться с этим, ниже приложу код который у меня уже получился, буду благодарен за помощь

код UserForm1:

Код (vb) Выделить Развернуть

Private Sub CommandButton1_Click()
Dim ILastRow As Long
Dim ILastRow2 As Long
Dim ILastRow3 As Long
Dim ILastRow4 As Long
Dim ILastRow5 As Long
ILastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "A").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "A").Value = Me.Calendar1.Value
ILastRow2 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "B").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "B").Value = Me.TextBox2.Value
ILastRow3 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "C").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "C").Value = Me.TextBox3.Value
ILastRow4 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "D").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "D").Value = Me.TextBox1.Value
ILastRow5 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "C").End(xlUp).Row - Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "B").End(xlUp).Row
Sheets("Лист2").Cells(ILastRow, "E").Value = Me.TextBox1.Value

End Sub


Private Sub UserForm_Initialize()
Me.TextBox2.Value = Format(Me.TextBox2, "hh:mm")
Me.TextBox3.Value = Format(Me.TextBox3, "hh:mm")
End Sub

Код (vb) Выделить Развернуть

Private Sub CommandButton1_Click()
Dim selectDate As Long
Dim RecordCount As TextBox
selectDate = Me.Calendar1.Value
RecordCount = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "A").End(xlUp).Row
For i = 1 To RecordCount
  If selectDate = Sheets("Лист2").Cells("A", i).Value Then
 Cells(5, 5) = 100 (это я для проверки вводил)
 End If
 Next i
End Sub

[Дмитрий Щербаков(The_Prist)]

Самое главное: удалил Ваш файл. Фильтруйте записи в файле. Ваши личные постельные дела с Настей, да еще выраженные в грубой форме, никому здесь не нужны. За повторное подобное нарушение получите БАН.
1. Контрол Microsoft Calendar 9.0 не поддерживается поздними версиями. Поэтому форма будет работать далеко не у всех.
Sheets("Лист2").Cells(ILastRow, "E").Value = cdate(Sheets("Лист2").Cells(ILastRow, "B").Value) - cdate(Sheets("Лист2").Cells(ILastRow, "C").Value)
2. Чтобы выгрузить форму используйте: Unload Me.
3. Не совсем понятно, какие календарные данные и куда надо ввести в форме, т.к. элемент календаря не подгружается...

[abdulazizov]

Извиняюсь за Настю, это вышло случайно)))) А что касаемо ответов:
1) она выдает ответ не в часах и минутах, а в виде -0,66444444

3) есть форма userform2, в которой календарь так же, так вот, при выоре к примеру даты 21.12.13 нужно чтобы столбцы (дата, начало, конец, меропритие, разница ) с такой же датой записала со 2го листа  в такие же столбцы первого листа.
Извиняюсь еще раз за Настю, помогите, в VBA Я не очень силен, не до конца понимаю его

[abdulazizov]

С разностью разобрался, остался лишь третий вопрос

[Дмитрий Щербаков(The_Prist)]

3. Наверное, как-то так:

Код (vb) Выделить Развернуть

   Dim ILastRow As Long, lr As Long
   Dim rCell As Range
   With Sheets("Лист2")
       ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       For Each rCell In Range(.Cells(3, 1), .Cells(ILastRow, 1))
           If CDate(rCell.Value) = CDate(TextBox1.Value) Then
               lr = rCell.Row: Exit For
           End If
       Next rCell
   End With
   If lr = 0 Then
       MsgBox "Указанной даты нет на листе 2", vbCritical
        exit sub
   End If
   With Sheets("Лист1")
       ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       For Each rCell In Range(.Cells(4, 1), .Cells(ILastRow, 1))
           If CDate(rCell.Value) = CDate(TextBox1.Value) Then
               .Cells(rCell.Row, "A").Value = Sheets("Лист2").Cells(lr, 1).Value
               .Cells(rCell.Row, "B").Value = Sheets("Лист2").Cells(lr, 2).Value
               .Cells(rCell.Row, "C").Value = Sheets("Лист2").Cells(lr, 4).Value
               .Cells(rCell.Row, "D").Value = Sheets("Лист2").Cells(lr, 5).Value
               Exit For
           End If
       Next rCell
   End With
   Unload Me
Правда, не уверен, что правильно указал из каких столбцов в какие записывать, но принцип такой.

[abdulazizov]

Код (vb) Выделить Развернуть

         If CDate(rCell.Value) = CDate(TextBox1.Value) Then
после данной строки дает жалобу type mismatch

[Дмитрий Щербаков(The_Prist)]

Значит там не дата.

[abdulazizov]

Прикрепил файл, на этот раз без Насти, гляньте если не сложно, где именно не дата, у меня вроде на обоих листах в столбце "Дата", формат Дата стоит

[Дмитрий Щербаков(The_Prist)]

Это понятно. Только вот где даты на лист1?
Посмотрите какое значение у rCell на момент ошибки. "Дата". Т.е. текст заголовка, потому что это последняя строка.
А вообще, наверное, надо было бы пояснить попонятнее. По сути я теперь только понял, что Вам очевидно надо в Лист1 записать данные со второго листа за выбранную в форме дату.
Замените этот блок:

Код (vb) Выделить Развернуть

    With Sheets("Лист1") 
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
        For Each rCell In Range(.Cells(4, 1), .Cells(ILastRow, 1)) 
            If CDate(rCell.Value) = CDate(TextBox1.Value) Then 
                .Cells(rCell.Row, "A").Value = Sheets("Лист2").Cells(lr, 1).Value 
                .Cells(rCell.Row, "B").Value = Sheets("Лист2").Cells(lr, 2).Value 
                .Cells(rCell.Row, "C").Value = Sheets("Лист2").Cells(lr, 4).Value 
                .Cells(rCell.Row, "D").Value = Sheets("Лист2").Cells(lr, 5).Value 
                Exit For 
            End If 
        Next rCell 
    End With
на такой:

Код (vb) Выделить Развернуть

    With Sheets("Лист1") 
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                .Cells(ILastRow, "A").Value = Sheets("Лист2").Cells(lr, 1).Value 
                .Cells(ILastRow, "B").Value = Sheets("Лист2").Cells(lr, 2).Value 
                .Cells(ILastRow, "C").Value = Sheets("Лист2").Cells(lr, 4).Value 
                .Cells(ILastRow, "D").Value = Sheets("Лист2").Cells(lr, 5).Value 
    End With

[abdulazizov]

Щас не дома, буду дома проверю и дам ответ))

[abdulazizov]

заменил, обратно на то же самое ругается.
Вот код по первой форме:

Код (vb) Выделить Развернуть


Private Sub CommandButton1_Click()
Dim ILastRow As Long
Dim ILastRow2 As Long
Dim ILastRow3 As Long
Dim ILastRow4 As Long
Dim ILastRow5 As Long
ILastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "A").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "A").Value = Me.Calendar1.Value
ILastRow2 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "B").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "B").Value = Me.TextBox2.Value
ILastRow3 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "C").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "C").Value = Me.TextBox3.Value
ILastRow4 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "D").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "D").Value = Me.TextBox1.Value
ILastRow5 = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "E").End(xlUp).Row + 1
Sheets("Лист2").Cells(ILastRow, "E").Value = ILastRow3 - ILastRow2
Sheets("Лист2").Cells(ILastRow, "E").Value = CDate(Sheets("Лист2").Cells(ILastRow, "C").Value) - CDate(Sheets("Лист2").Cells(ILastRow, "B").Value)
Unload Me
End Sub


Private Sub UserForm_Initialize()
Me.TextBox2.Value = Format(Me.TextBox2, "hh:mm")
Me.TextBox3.Value = Format(Me.TextBox3, "hh:mm")
'Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, "E")`
End Sub


вот по второй:

Код (vb) Выделить Развернуть

Private Sub CommandButton1_Click()
      Dim ILastRow As Long, lr As Long
    Dim rCell As Range
    With Sheets("Лист2")
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each rCell In Range(.Cells(3, 1), .Cells(ILastRow, 1))
            If CDate(rCell.Value) = CDate(TextBox1.Value) Then
                lr = rCell.Row: Exit For
            End If
        Next rCell
    End With
    If lr = 0 Then
        MsgBox "Данной даты нет на листе 2", vbCritical
        Exit Sub
    End If
    With Sheets("Лист1")
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each rCell In Range(.Cells(4, 1), .Cells(ILastRow, 1))
            If CDate(rCell.Value) = CDate(TextBox1.Value) Then
                .Cells(rCell.Row, "A").Value = Sheets("Лист2").Cells(lr, 1).Value
                .Cells(rCell.Row, "B").Value = Sheets("Лист2").Cells(lr, 2).Value
                .Cells(rCell.Row, "C").Value = Sheets("Лист2").Cells(lr, 4).Value
                .Cells(rCell.Row, "D").Value = Sheets("Лист2").Cells(lr, 5).Value
                .Cells(rCell.Row, "E").Value = Sheets("Лист2").Cells(lr, 5).Value
                Exit For
            End If
        Next rCell
    End With
    Unload Me
End Sub
в обоих столбцах "А" на обоих листах стоит формат дата, так в чем дело, что он хочет?

[Дмитрий Щербаков(The_Prist)]

и что Вы изменили? Можете все же прочитаете, что я предлагал заменить и на что?

[abdulazizov]

Код (vb) Выделить Развернуть

Private Sub CommandButton1_Click()
      Dim ILastRow As Long, lr As Long
    Dim rCell As Range
    With Sheets("Лист2")
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each rCell In Range(.Cells(3, 1), .Cells(ILastRow, 1))
            If CDate(rCell.Value) = CDate(TextBox1.Value) Then
                lr = rCell.Row: Exit For
            End If
        Next rCell
    End With
    If lr = 0 Then
        MsgBox "Данной даты нет на листе 2", vbCritical
        Exit Sub
    End If
     With Sheets("Лист1")
        ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                .Cells(ILastRow, "A").Value = Sheets("Лист2").Cells(lr, 1).Value
                .Cells(ILastRow, "B").Value = Sheets("Лист2").Cells(lr, 2).Value
                .Cells(ILastRow, "C").Value = Sheets("Лист2").Cells(lr, 4).Value
                .Cells(ILastRow, "D").Value = Sheets("Лист2").Cells(lr, 5).Value
                .Cells(ILastRow, "E").Value = Sheets("Лист2").Cells(lr, 6).Value
    End With
    Unload Me
End Sub

так же желуется,что делать с этим type mismatch

[abdulazizov]

Код (vb) Выделить Развернуть

If CDate(rCell.Value) = CDate(TextBox1.Value) Then вот на этом месте жалуется, не до конца понял ваше объяснение

[Дмитрий Щербаков(The_Prist)]

Ну так посмотрите какое значение у rCell. или что записано в TextBox1. Если там так и красуется - "Выбор даты", то не удивительно. Этот текст датой не является.
А что непонятного в моем объяснении? И каком именно объяснении? Посмотрите на код в Вашем сообщении #10. Там ничего не изменено. Второй цикл как был - так и остался. А я предлагал его убрать и написал чем заменить.

Или выложите здесь файл со всеми этими изменениями и напишите, что и как указываете.