在右侧的下一个空单元格中输入用户表单文本值

Question

希望将我的用户表单中的日期输入联系人 1，然后如果我为同一客户输入另一个日期，我希望它转到联系人 2、联系人 3 等等。即使我点击了客户 6，我也希望能够做到这一点。基本上这应该转到右边的下一个空联系人。

客户名单

用户窗体

这是我的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

Answer 1

您只需要一个循环来找到第一个空的 "Contact 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

在右侧的下一个空单元格中输入用户表单文本值

Input userform text valie to next empty cell to the right

excel

vba

userform