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

您只需要一个循环来查找第一个空的“联系 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

将userform文本值输入到右侧的下一个空单元格

1 个答案: