Сохранить данные из пользовательской формы VBA на двух листах - PullRequest
Новая
       8

Сохранить данные из пользовательской формы VBA на двух листах

0 голосов
/ 30 августа 2018

Я пытаюсь сохранить данные, введенные в пользовательской форме, в различные листы.

Проблема, с которой я сталкиваюсь в настоящее время, заключается в том, что один из листов VBA должен искать конкретную строку, в которую он должен быть добавлен, но другой лист будет представлять собой историю вставленных данных, поэтому он должен вставьте данные в следующую свободную строку.

У меня есть этот код, который работает для поиска и вставки в первый лист: 

Private Sub pSave()

Dim rw As Integer
Dim ws As Worksheet
    Set ws = Worksheets("Hardware")

    'Takting the inserted values from the userform and inserting them into the spreadsheet

        totRows = Worksheets("Hardware").Range("A4").CurrentRegion.Rows.Count

        For i = 2 To totRows
            If Trim(Worksheets("Hardware").Cells(i, 1)) = Trim(ComboBox_PCNameChoose.Value) Then
            'Inserting them into the Hardware sheet (The main sheet)
                Worksheets("Hardware").Cells(i, 12).Value = TextBox_Name.Text
                Worksheets("Hardware").Cells(i, 13).Value = TextBox_Email.Text
                Worksheets("Hardware").Cells(i, 14).Value = TextBox_PhoneNumber.Text
                Worksheets("Hardware").Cells(i, 15).Value = DTPicker_Borrow.Value
                Worksheets("Hardware").Cells(i, 16).Value = DTPicker_Return.Value

            Exit For
        End If
    Next i

Я знаю, что это работает в другой пользовательской форме для вставки данных в следующую свободную строку, но я не могу понять, как заставить это работать при сохранении на двух листах одновременно 

Dim rw As Integer
Dim ws2 As Worksheet

Set ws2 = Worksheets("Rental_History")
If rw = ws2.Cells.Find(What:="*", Searchorder:=xlRows, SearchDirection:=Previous, LookIn:=xlValues).Row + 1 Then
    ws2.Cells(rw, 10).Value = TextBox_Name.Text
    ws2.Cells(rw, 11).Value = TextBox_Email.Text
    ws2.Cells(rw, 12).Value = TextBox_PhoneNumber.Text
    ws2.Cells(rw, 13).Value = DTPicker_Borrow.Value
    ws2.Cells(rw, 14).Value = DTPicker_Return.Value
End If

Заранее, спасибо за ваше время и помощь! :)

С наилучшими пожеланиями - Кира

Ответы [ 2 ]

0 голосов
/ 30 августа 2018 
Dim rw As Integer
Dim ws As Worksheet
Set ws = Worksheets("Hardware")
Dim rw1 As Integer
Dim ws2 As Worksheet
Set ws2 = Worksheets("Rental_History")

'Takting the inserted values from the userform and inserting them into the spreadsheet

    totRows = Worksheets("Hardware").Range("A4").CurrentRegion.Rows.Count

    For i = 2 To totRows
        If Trim(Worksheets("Hardware").Cells(i, 1)) = Trim(ComboBox_PCNameChoose.Value) Then
        'Inserting them into the Hardware sheet (The main sheet)
            rw = ws2.Cells.Find(What:="*", Searchorder:=xlRows, SearchDirection:=Previous, LookIn:=xlValues).Row + 1 'updates rw  as it changes at each loop
            ws.Cells(i, 12).Value = TextBox_Name.Text
            ws2.Cells(rw, 10).Value = ws.Cells(i, 12).Value
            ws.Cells(i, 13).Value = TextBox_Email.Text
            ws2.Cells(rw, 11).Value = ws.Cells(i, 13).Value
            ws.Cells(i, 14).Value = TextBox_PhoneNumber.Text
            ws2.Cells(rw, 12).Value = ws.Cells(i, 14).Value
            ws.Cells(i, 15).Value = DTPicker_Borrow.Value
            ws2.Cells(rw, 13).Value = ws.Cells(i, 15).Value
            ws.Cells(i, 16).Value = DTPicker_Return.Value
            ws2.Cells(rw, 14).Value = ws.Cells(i, 16).Value
       End If
   Next i
0 голосов
/ 30 августа 2018

Я полагаю, что следующее даст то, что вы ожидаете, вместо того, чтобы использовать цикл For Loop для поиска строки, в которую вы хотите добавить первый бит данных, я использовал метод .Find, так как это было бы быстрее, а не циклически в каждой строке, пока вы не найдете совпадение, метод find будет быстро переходить к сопоставленной строке.

Также важно отметить, что я изменил объявление rw с Integer на Long, так как в Excel больше ячеек, чем переменная Integer может обработать: 

Private Sub pSave()
Dim rw As Long
Dim ws As Worksheet: Set ws = Worksheets("Hardware")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Rental_History")
Dim foundval As Range

'Taking the inserted values from the userform and inserting them into the spreadsheet
Set foundval = ws.Range("A:A").Find(What:=Trim(ComboBox_PCNameChoose.Value)) 'find the value that matches
If Not foundval Is Nothing Then 'if found, use that row to insert data
    'Inserting them into the Hardware sheet (The main sheet)
    ws.Cells(foundval.Row, 12).Value = TextBox_Name.Text
    ws.Cells(foundval.Row, 13).Value = TextBox_Email.Text
    ws.Cells(foundval.Row, 14).Value = TextBox_PhoneNumber.Text
    ws.Cells(foundval.Row, 15).Value = DTPicker_Borrow.Value
    ws.Cells(foundval.Row, 16).Value = DTPicker_Return.Value
End If

rw = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
'get the next free row
ws2.Cells(rw, 10).Value = TextBox_Name.Text
ws2.Cells(rw, 11).Value = TextBox_Email.Text
ws2.Cells(rw, 12).Value = TextBox_PhoneNumber.Text
ws2.Cells(rw, 13).Value = DTPicker_Borrow.Value
ws2.Cells(rw, 14).Value = DTPicker_Return.Value
End Sub
...