在Excel工作表vba中得到一个循环

时间:2016-11-05 17:05:36

标签: excel vba excel-vba

我正在做一张有一个单元格的工作表,让用户输入首期付款金额,然后显示它的百分比。 我还有另一行有一个解锁的单元格供用户输入百分比,它将填写首期付款金额。 我知道这很尴尬,实际上我想要的只是1个单元用于首付,另一个单元用于15%但是我在编写公式时遇到了麻烦。 因为我的技能非常糟糕,我在“sheet1 change”上使用了一个事件处理程序,它在那些字段中查找更改然后隐藏未使用的字段 更大的问题是,当计算完成时,我在工作表上有一个按钮可以立即清除所有未锁定的单元格。然后,“清除单元格”按钮清除我在“工作表更改”代码中引用的单元格并导致循环 如果有更好的方法在条形图上输入一个公式,只有一行同时具有百分比单元格和单元格作为首期付款金额,并让用户进入其中一个而另一个自动填充。即:首付款/总金额填入%单元格。或者,如果输入百分比,则百分比*总金额将在首期付款金额中填入美元值。对不起,如果这令人困惑,我试图说清楚。

Private Sub Worksheet_Change(ByVal Target As range)

    If Target.Address = "$B$5" Then
        MsgBox "Down Payment Percent Chosen"

        'want to change Range A6 to D6 to hidden or locked
        range("6:6").EntireRow.Hidden = True
    End If

    If Target.Address = "$D$6" Then
        MsgBox "Down Payment Amount Chosen"

        'range("B5").Value = 0

        range("5:5").EntireRow.Hidden = True
    End If

    'If Target.Address = "$D$6" Then
    '    MsgBox "Amount Chosen"
    '    Rows("5:5").EntireRow.Hidden = False
    'End If

    'If Target.Address = "$B$5" Then
    '    MsgBox "% Chosen"
    '    Rows("6:6").EntireRow.Hidden = False
    'End If

End Sub

Sub ClearTEst()

    Dim ws As Worksheet
    Dim rRng As range
    Dim rCell As range
    Dim rRows As range

    Set rRng = Sheet1.range("A1:D28")

    'Need to bring hidden row back
    If Rows("5:5").EntireRow.Hidden = True Then
        Rows("5:5").EntireRow.Hidden = False
    End If

    If Rows("6:6").EntireRow.Hidden = True Then
        Rows("6:6").EntireRow.Hidden = False

    End If


    For Each rCell In rRng.Cells

        If rCell.Locked = False Then
            MsgBox "testing"
            Debug.Print rCell.Address, rCell.Value
            rCell.ClearContents

        End If

    Next rCell

    'got from internet

End Sub

抱歉,我不知道如何将代码格式化为灰色,以便在此处查看。我看到其中一些是灰色但不完全知道为什么或如何。我选择了所有代码然后按下上面的代码按钮但是你可以看到我也可以使用这个帮助:)

谢谢 卡罗尔

2 个答案:

答案 0 :(得分:0)

暂时禁用事件:

Sub ClearTEst()
    Dim rRng As Range, rCell As Range

    Set rRng = Sheet1.Range("A1:D28")

    Rows("5:5").EntireRow.Hidden = False '<--| no need to check if row is hidden, just set it visible
    Rows("6:6").EntireRow.Hidden = False '<--| no need to check if row is hidden, just set it visible

    Application.EnableEvents = False '<--| disable events handling
    On Error GoTo ErrorHandler '<--| be sure to catch any error and enable events handling back
    For Each rCell In rRng.Cells
        If rCell.Locked = False Then
            MsgBox "testing"
            Debug.Print rCell.Address, rCell.Value
            rCell.ClearContents
        End If
    Next rCell

ErrorHandler:
    Application.EnableEvents = True'<--| enable events handling

End Sub

编辑:使用相同的技术添加更改事件代码

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False '<--| disable events handling
    On Error GoTo ErrorHandler '<--| be sure to catch any error and enable events handling back
    Select Case Target.Address
        Case "$B$2" ' Downpayment inout
            Range("B3") =  (Range("B2").Value / Range("B1").Value) * 100
        Case "$B$3" ' Percent entered
            Range("B2").Value =  (Range("B1").Value * Range("B3").Value) / 100
    End Select
ErrorHandler:
    Application.EnableEvents = True'<--| enable events handling
End Sub

答案 1 :(得分:0)

我从您的问题中了解到,您需要一个预付定金额的单元格,以及一个百分比的单元格,并且您希望根据其他单元格的输入自动填充任一单元格。

如果那是对的,以下是这样做的一个工作示例。单元格B1包含总金额,B2包含预付款,B3包含百分比。如果用户编辑B2,则单元格B3将按百分比填充,反之亦然。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$2" Then
        ' Downpayment entered
        Percent = (Range("B2").Value / Range("B1").Value) * 100
        Range("B3") = Percent
    End If

    If Target.Address = "$B$3" Then
        ' Percent entered
        Downpayment = (Range("B1").Value * Range("B3").Value) / 100
        Range("B2").Value = Downpayment
    End If

End Sub

如果清除按钮仅清除用户输入的单元格,如预付款和百分比,那么您只需清除那些单元格,而无需遍历某个范围来查找未锁定的单元格。这样可以提高代码的性能,因为它不必遍历范围。

enter image description here