Excel VBA - 使用复制的公式在已命名范围中插入的新行中输入Userform数据

时间:2016-08-19 21:22:35

标签: excel vba excel-vba

我是Excel VBA的新手,我正在通过试验和错误以及Stack Overflow上的小时数来学习。我花了几个小时寻找一个解决方案(仍在弄清楚如何最好地解决谷歌VBA问题......)但是没有找到一个我能理解的解决方案,所以任何对现有线程的帮助或指导都会受到最多的赞赏。

我原本希望我的代码将用户表单数据输入到特定命名范围内的下一个空行,但现在我意识到我需要它更灵活。

Sheets("Budget Input").Range("ContractInputField") 

目前是A50:E50。 F50:V50包含需要携带与我的范围一样多的行的公式。

当用户点击用户表单上的“确定”时,我需要:

  • 要在现有范围内插入的新行(在“ContractInputField”内,在该范围的最后一个条目下方以及不在该范围内且已经具有宝贵内容的其他行之上)
  • 复制上面行中存在的公式的新行(当前行50但是会在第一个“ok”时增长到51,然后在第二个“ok”中增加到51,依此类推)
  • 要输入新行的用户表单数据

以下是我原始方法的代码:

Private Sub cmdOK_Click()
 Dim J As Long

Sheets("Budget Input").Activate
ActiveSheet.Range("ContractInputLine1").Activate

Do While IsEmpty(ActiveCell.Offset(J, 0)) = False
    J = J + 1
Loop

ActiveCell.Offset(J, 0).Value = Me.txtContractorName.Value
ActiveCell.Offset(J, 1).Value = Me.txtContractPurpose.Value
ActiveCell.Offset(J, 2).Value = Me.txtFlatRate.Value
ActiveCell.Offset(J, 3).Value = Me.txtContractHourlyRate.Value
ActiveCell.Offset(J, 4).Value = Me.txtContractHours.Value
ActiveCell.Offset(J, 16).Value = Me.ContractYear2.Value
ActiveCell.Offset(J, 17).Value = Me.ContractYear3.Value
ActiveCell.Offset(J, 18).Value = Me.ContractYear4.Value


'Clear boxes before next round of entry
Dim ctl As Control

For Each ctl In Me.Controls
    If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
        ctl.Value = " "
    ElseIf TypeName(ctl) = "CheckBox" Then
        ctl.Value = False
    End If

Next ctl

End Sub

我喜欢任何指导!谢谢!

1 个答案:

答案 0 :(得分:0)

你可以尝试:

Private Sub cmdOK_Click()
    Dim J As Long
    Dim c As Long

    With Sheets("Budget Input")
        J = .Range("ContractInputLine1").Row
        c = .Range("ContractInputLine1").Column

        Do While Not IsEmpty(.Cells(J, c))
            J = J + 1
        Loop

        'Insert a new row for the new data, to ensure we don't start writing
        ' beyond the end of the ContractInputField range.  (Assumption is
        ' that there is already at least 1 blank row included at the end of
        ' ContractInputField or else even this won't stop the range being
        ' exceeded.)
        .Rows(J).EntireRow.Insert

        'Copy values, formulae, and formats from the previous row
        .Rows(J).EntireRow.FillDown

        'Replace values with values from the form    
        .Cells(J, c + 0).Value = Me.txtContractorName.Value
        .Cells(J, c + 1).Value = Me.txtContractPurpose.Value
        .Cells(J, c + 2).Value = Me.txtFlatRate.Value
        .Cells(J, c + 3).Value = Me.txtContractHourlyRate.Value
        .Cells(J, c + 4).Value = Me.txtContractHours.Value
        .Cells(J, c + 16).Value = Me.ContractYear2.Value
        .Cells(J, c + 17).Value = Me.ContractYear3.Value
        .Cells(J, c + 18).Value = Me.ContractYear4.Value
    End With

    'Clear boxes before next round of entry
    Dim ctl As Control

    For Each ctl In Me.Controls
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = " "
        ElseIf TypeName(ctl) = "CheckBox" Then
            ctl.Value = False
        End If

    Next ctl

End Sub

注意:

1)你会注意到我在代码中摆脱了ActiveCell。这只是我个人的偏好 - 我不喜欢激活或选择的东西,除非我绝对必须 - 所以如果你觉得有必要改变它。

2)在摆脱ActiveCell时,我必须包含一个变量c以防万一ContractInputLine1不在A列中。如果它确实从A列开始,c可以在任何地方替换为1,例如,c + 2替换为3