Введите пользовательский текст valie в следующую пустую ячейку справа - PullRequest
0 голосов
/ 26 апреля 2018

Нужно ввести даты из моей пользовательской формы в контакт 1, а затем, если я назначу другую дату для того же клиента, я хочу, чтобы она перешла в контакт 2, контакт 3 и так далее.Я хочу иметь возможность сделать это, даже если я нажму на клиента 6. По сути, это должно перейти к следующему пустому контакту справа.

Список клиентов

image

Пользовательская форма

image

Вот мой VBA

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Contacts")
    Set WS2 = ThisWorkbook.Sheets("Lending")
    Set WS3 = ThisWorkbook.Sheets("Deposits")
    Set WS4 = ThisWorkbook.Sheets("Client Notes")

    x = Me.lblRow 'current row

    ws.Cells(x, 4) = Me.clientname
    WS4.Cells(x, 5) = Me.clientnotes
    WS2.Cells(x, 5) = Me.mortgage1.Value
    WS2.Cells(x, 8) = Me.mortgage2.Value
    WS2.Cells(x, 13) = Me.helocrate.Value
    WS2.Cells(x, 14) = Me.helocbalance.Value
    WS2.Cells(x, 16) = Me.bline.Value
    WS2.Cells(x, 17) = Me.blinerate.Value
    WS2.Cells(x, 18) = Me.bloan.Value
    WS2.Cells(x, 19) = Me.bloanrate.Value
    WS3.Cells(x, 5) = Me.cchecking.Value
    WS3.Cells(x, 6) = Me.csavings.Value
    WS3.Cells(x, 8) = Me.cdbalance.Value
    WS3.Cells(x, 9) = Me.cdrate.Value
    WS3.Cells(x, 10) = Me.bchecking.Value
    WS3.Cells(x, 11) = Me.bsavings.Value
    WS2.Cells(x, 7) = Me.mrate1.Value
    WS2.Cells(x, 6) = Me.mortgagerate1.Value
    WS2.Cells(x, 9) = Me.mortgagerate2.Value
    ws.Cells(x, 5) = Me.cdates1.Value

    Unload Me
    ActiveSheet.Protect "password"
End Sub

1 Ответ

0 голосов
/ 26 апреля 2018

Вам просто нужен цикл, чтобы найти первый пустой столбец "Контакт N ".Здесь тоже немного кода приведено в порядок.Обратите внимание, что это не перестанет искать проход 6-го контакта.

Private Sub CommandButton1_Click()
    Dim x As Long, c As Long
    Const CONTACT_START As Long = 5 ' Column E
    Const COL_PER_CONTACT As Long = 3 ' Columns per Contact

    x = CLng(Me.lblRow) 'current row

    With ThisWorkbook.Sheets("Contacts")
        c = CONTACT_START
        ' Look for first empty one
        Do Until IsEmpty(.Cells(x, c))
            c = c + COL_PER_CONTACT
        Loop
        .Cells(x, c) = Me.clientname
        .Cells(x, c + 1) = Me.cdates1.Value
    End With

    With ThisWorkbook.Sheets("Lending")
        .Cells(x, 5) = Me.mortgage1.Value
        .Cells(x, 6) = Me.mortgagerate1.Value
        .Cells(x, 7) = Me.mrate1.Value
        .Cells(x, 8) = Me.mortgage2.Value
        .Cells(x, 9) = Me.mortgagerate2.Value
        .Cells(x, 13) = Me.helocrate.Value
        .Cells(x, 14) = Me.helocbalance.Value
        .Cells(x, 16) = Me.bline.Value
        .Cells(x, 17) = Me.blinerate.Value
        .Cells(x, 18) = Me.bloan.Value
        .Cells(x, 19) = Me.bloanrate.Value
    End With

    With ThisWorkbook.Sheets("Deposits")
        .Cells(x, 5) = Me.cchecking.Value
        .Cells(x, 6) = Me.csavings.Value
        .Cells(x, 8) = Me.cdbalance.Value
        .Cells(x, 9) = Me.cdrate.Value
        .Cells(x, 10) = Me.bchecking.Value
        .Cells(x, 11) = Me.bsavings.Value
    End With

    With ThisWorkbook.Sheets("Client Notes")
        .Cells(x, 5) = Me.clientnotes
    End With

    Unload Me
    ActiveSheet.Protect "password"
End Sub
...