當輸入值改變時刷新用戶定義的函數

嗨我有問題，獲取我創建的用戶定義函數刷新時，當我的輸入值更改。實際上，輸入值是由另一個宏「治理」的，這就是爲什麼我認爲函數沒有被真正觸發（事實上，它被刷新但是被「1步」延遲），而我實際上使用Application.Volatile：）所以你能幫我嗎？ :)當輸入值改變時刷新用戶定義的函數

下面是函數：

Public Function AvColor(ByRef myRange As Range) As Double 


ActiveSheet.Unprotect 

Application.Volatile 

Dim Sum As Integer 

Sum = 0 

Dim Count As Integer 

Count = 0 

For Each Cell In myRange 

If Cell.Interior.ColorIndex = 3 Then 

Sum = Sum + 1 

ElseIf Cell.Interior.ColorIndex = 44 Then 

Sum = Sum + 2 

ElseIf Cell.Interior.ColorIndex = 6 Then 

Sum = Sum + 3 

ElseIf Cell.Interior.ColorIndex = 43 Then 

Sum = Sum + 4 

ElseIf Cell.Interior.ColorIndex = 33 Then 

Sum = Sum + 5 

ElseIf Cell.Interior.ColorIndex = Blank Then 

Sum = Sum 


End If 

Count = Count + 1 

Next Cell 


AvColor = Round(Sum/Count) 



ActiveSheet.Protect 


End Function

，這裏是我的微距用於整個工作表：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim icolor As Integer 
ActiveSheet.Unprotect 
Application.Volatile True 
For i = 4 To 35 

     If Not Intersect(Target, Range(Cells(i, 15), Cells(i, 18))) Is Nothing Then 

     For Each Cell In Range(Cells(i, 15), Cells(i, 18)) 

     'Increase 5 

       If Cells(i, 4).Value = 1 Then 

      If Cell = Blank Then 

       icolor = Blank 

      ElseIf Cell < Cells(i, 5) Then 

       icolor = 3 
      ElseIf Cell < Cells(i, 7) Then 

       icolor = 44 

      ElseIf Cell < Cells(i, 9) Then 
       icolor = 6 
      ElseIf Cell <= Cells(i, 11) Then 

       icolor = 43 
      ElseIf Cell > Cells(i, 11) Then 

       icolor = 33 
      Else 
       'Whatever 

      End If 


     ''''''''''''''''''''''''''''''''''' 
     'Increase 3 

     ElseIf Cells(i, 4).Value = 2 Then 

       If Cell = Blank Then 

       icolor = Blank 

      ElseIf Cell < Cells(i, 5) Then 
       icolor = 3 

      ElseIf Cell <= Cells(i, 7) Then 
       icolor = 44 

      ElseIf Cell > Cells(i, 7) Then 
       icolor = 6 
      'ElseIf cell < Cells(i, 11) Then 
       'icolor = 43 

      'ElseIf cell >= Cells(i, 13) Then 
       'icolor = 33 

      Else 
       'Whatever 

      End If 

     ''''''''''''''''''''''''''''''''''' 

     'Decrease 5 

     ElseIf Cells(i, 4).Value = 3 Then 

      If Cell = Blank Then 

       icolor = Blank 

      ElseIf Cell > Cells(i, 5) Then 

       icolor = 3 
      ElseIf Cell > Cells(i, 7) Then 

       icolor = 44 

      ElseIf Cell > Cells(i, 9) Then 
       icolor = 6 
      ElseIf Cell > Cells(i, 11) Then 

       icolor = 43 
      ElseIf Cell <= Cells(i, 11) Then 

       icolor = 33 
      Else 
       'Whatever 

      End If 

     ''''''''''''''''''''''''''''''''''' 

     'Decrease 3 


     ElseIf Cells(i, 4).Value = 4 Then 

        If Cell = Blank Then 

       icolor = Blank 

      ElseIf Cell > Cells(i, 5) Then 

       icolor = 3 
      ElseIf Cell >= Cells(i, 7) Then 

       icolor = 44 

      ElseIf Cell < Cells(i, 7) Then 
       icolor = 6 
      'ElseIf cell > Cells(i, 11) Then 

       'icolor = 43 
      'ElseIf cell <= Cells(i, 13) Then 

       'icolor = 33 

      Else 

       'Whatever 

      End If 


     ''''''''''''''''''''''''''''''''''' 

     'Non-Linear 5 

     ElseIf Cells(i, 4).Value = 5 Then 

        If Cell = Blank Then 

       icolor = Blank 


      ElseIf Cell < Cells(i, 5) Then 

       icolor = 3 

      ElseIf Cell > Cells(i + 1, 5) Then 

       icolor = 3 
      ElseIf Cell < Cells(i, 7) Then 

       icolor = 44 

      ElseIf Cell > Cells(i + 1, 7) Then 

       icolor = 44 

      ElseIf Cell < Cells(i, 9) Then 

       icolor = 6 

      ElseIf Cell > Cells(i + 1, 9) Then 

       icolor = 6 

      ElseIf Cell < Cells(i, 11) Then 
       icolor = 43 

      ElseIf Cell > Cells(i + 1, 11) Then 
       icolor = 43 
      ElseIf Cell >= Cells(i, 11) Then 

       icolor = 33 

      ElseIf Cell <= Cells(i + 1, 11) Then 

       icolor = 33 

      Else 
       'whatever 
     End If 

       ''''''''''''''''''''''''''''''''''' 

     'Non-Linear 3 

     ElseIf Cells(i, 4).Value = 6 Then 

      If Cell = Blank Then 

       icolor = Blank 

      ElseIf Cell < Cells(i, 5) Then 

       icolor = 3 
      ElseIf Cell < Cells(i, 7) Then 

       icolor = 44 

      ElseIf Cell <= Cells(i, 9) Then 
       icolor = 6 
      ElseIf Cell <= Cells(i, 11) Then 

       icolor = 44 

      ElseIf Cell > Cells(i, 11) Then 

       icolor = 3 
      Else 
       'whatever 
     End If 



     Else 

     Msg = "Error" 

     End If 
     Cell.Interior.ColorIndex = icolor 



    Next Cell 


    End If 
    Next i 
    ActiveSheet.Protect 
    End Sub**

來源

2014-10-16 Fady Fadel

首先，您不能在UDF中更改工作表保護。其次，'Application.Volatile'在除UDF以外的任何其他方面都沒有意義。第三，更改單元格顏色不會觸發重新計算，因此您的更改事件在更改單元格顏色後將不得不這樣做。最後，不要使用顏色作爲數據。 :) – Rory 2014-10-16 14:14:30

嗨@Rory，謝謝你的回答：你能幫我添加這個改變事件，將觸發計算？事實上，我需要使用顏色，所以如果不是Data，你有什麼建議？謝謝 – 2014-10-16 14:28:52

嗨Rory，謝謝你的回答：你能幫我添加這個會觸發計算的變化事件嗎？事實上，我需要使用顏色，所以如果不是Data，你有什麼建議？謝謝 - @Rory – 2014-10-16 14:45:55

首先拆下解除和保護您的函數語句。然後將更改代碼更改爲：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim icolor    As Long 
    Dim i      As Long 
    Dim rCell     As Excel.Range 

    ActiveSheet.Unprotect 

    If Not Intersect(Target, Range(Cells(4, 15), Cells(35, 18))) Is Nothing Then 
     For i = 4 To 35 

      For Each Cell In Range(Cells(i, 15), Cells(i, 18)) 

       'Increase 5 

       If Cells(i, 4).Value = 1 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell.Value2 < Cells(i, 5).Value2 Then 

         icolor = 3 
        ElseIf Cell.Value2 < Cells(i, 7).Value2 Then 

         icolor = 44 

        ElseIf Cell.Value2 < Cells(i, 9).Value2 Then 
         icolor = 6 
        ElseIf Cell.Value2 <= Cells(i, 11).Value2 Then 

         icolor = 43 
        ElseIf Cell.Value2 > Cells(i, 11).Value2 Then 

         icolor = 33 
        End If 


        ''''''''''''''''''''''''''''''''''' 
        'Increase 3 

       ElseIf Cells(i, 4).Value = 2 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell < Cells(i, 5) Then 
         icolor = 3 

        ElseIf Cell <= Cells(i, 7) Then 
         icolor = 44 

        ElseIf Cell > Cells(i, 7) Then 
         icolor = 6 

        End If 

        ''''''''''''''''''''''''''''''''''' 

        'Decrease 5 

       ElseIf Cells(i, 4).Value = 3 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell > Cells(i, 5) Then 

         icolor = 3 
        ElseIf Cell > Cells(i, 7) Then 

         icolor = 44 

        ElseIf Cell > Cells(i, 9) Then 
         icolor = 6 
        ElseIf Cell > Cells(i, 11) Then 

         icolor = 43 
        ElseIf Cell <= Cells(i, 11) Then 

         icolor = 33 
        End If 

        ''''''''''''''''''''''''''''''''''' 

        'Decrease 3 


       ElseIf Cells(i, 4).Value = 4 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell > Cells(i, 5) Then 

         icolor = 3 
        ElseIf Cell >= Cells(i, 7) Then 

         icolor = 44 

        ElseIf Cell < Cells(i, 7) Then 
         icolor = 6 
        End If 


        ''''''''''''''''''''''''''''''''''' 

        'Non-Linear 5 

       ElseIf Cells(i, 4).Value = 5 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell < Cells(i, 5) Then 

         icolor = 3 

        ElseIf Cell > Cells(i + 1, 5) Then 

         icolor = 3 
        ElseIf Cell < Cells(i, 7) Then 

         icolor = 44 

        ElseIf Cell > Cells(i + 1, 7) Then 

         icolor = 44 

        ElseIf Cell < Cells(i, 9) Then 

         icolor = 6 

        ElseIf Cell > Cells(i + 1, 9) Then 

         icolor = 6 

        ElseIf Cell < Cells(i, 11) Then 
         icolor = 43 

        ElseIf Cell > Cells(i + 1, 11) Then 
         icolor = 43 
        ElseIf Cell >= Cells(i, 11) Then 

         icolor = 33 

        ElseIf Cell <= Cells(i + 1, 11) Then 

         icolor = 33 

        End If 

        ''''''''''''''''''''''''''''''''''' 

        'Non-Linear 3 

       ElseIf Cells(i, 4).Value = 6 Then 

        If Cell.Value2 = vbNullString Then 

         icolor = xlColorIndexNone 

        ElseIf Cell < Cells(i, 5) Then 

         icolor = 3 
        ElseIf Cell < Cells(i, 7) Then 

         icolor = 44 

        ElseIf Cell <= Cells(i, 9) Then 
         icolor = 6 
        ElseIf Cell <= Cells(i, 11) Then 

         icolor = 44 

        ElseIf Cell > Cells(i, 11) Then 

         icolor = 3 
        End If 
       Else 

        Msg = "Error" 

       End If 
       Cell.Interior.ColorIndex = icolor 

      Next Cell 

     Next i 
    End If 
    Application.Calculate 
    ActiveSheet.Protect 
End Sub

來源

2014-10-16 14:46:47 Rory

嗨，再次感謝很多:)它現在的作品。然而，通過這次更新，在第一次改變平均值之後，它的背景顏色會發生變化，並且如果值再次發生變化，則不會有反應。因此，對於所有單元格，數值和顏色都可以正常工作，除了在單元格中有函數的位置：值會更改，但顏色只會更改一次，然後保持原樣。在此先感謝您@Rory – 2014-10-16 15:57:59

如果單元格中包含公式，則重新計算不會觸發Change事件，只會觸發Calculate事件。您使用的是哪個版本的Excel？ – Rory 2014-10-16 16:04:21

我使用Excel 2013，有什麼建議嗎？感謝百萬@Rory – 2014-10-16 16:05:36

當輸入值改變時刷新用戶定義的函數

回答

相關問題