VBA - 当前单元格值在具有相同(用户定义)功能的其他单元格中重复

时间:2016-02-22 22:10:20

标签: excel vba excel-vba

新来的,如果我错过礼仪,请道歉。

我在Excel中编写了一个VBA函数。它似乎对当前单元格正常工作,但它在具有该函数的所有单元格中重复其值。

即 - 列Q中的许多单元格具有此公式= ScoreQ5()。如果我在单元格Q2中并按F2来更新该值,它将更新Q3,Q4等,并使它们等于Q2的值。因此Q2将是正确的,但其他可能不是。

我想也许我不应该使用ActiveCell,但我无法在网上找到任何暗示它应该这样做的东西。有什么想法吗?

谢谢

这是函数的代码

Function ScoreQ5()
Application.Volatile
Dim LDoF200 As Integer
Dim LDoF225 As Integer
Dim HDoF204 As Integer
Dim HDoF205 As Integer
Dim LDoF50P As Integer
Dim LDoF51P As Integer
Dim HDoF50P As Integer
Dim HDoF51P As Integer
Dim LastRow As Integer
Dim current As Long
Dim question As Long
Dim LDoF As Integer
Dim HDoF As Integer

current = 0
LDoF200 = 0
LDoF225 = 0
HDoF204 = 0
HDoF205 = 0
LDoF50P = 0
LDoF51P = 0
HDoF50P = 0
HDoF51P = 0
question = 0
LDoF = 0
HDoF = 0
LastRow = ActiveSheet.UsedRange.Rows.Count

For i = 1 To LastRow
    If Cells(i, 2) = ActiveCell.Offset(0, -15) Then
    current = current + 1
        If StrComp(Cells(i, 11), "5 - RedChemical_Threshold") = 0 Then
        question = question + 1
            If Cells(i, 24) = 200 Then
                If StrComp(Cells(i, 9), "LDoF") = 0 Then
                LDoF = LDoF + 1

                    If Cells(i, 23) = 200 Then
                    LDoF200 = 1
                    ElseIf Cells(i, 23) = 225 Then
                    LDoF225 = 1
                    End If

                    If Cells(i, 25) = 50 Then
                    LDoF50P = 1
                    ElseIf Cells(i, 25) = 51 Then
                    LDoF51P = 1
                    End If
                Else
                HDoF = HDoF + 1

                    If Cells(i, 23) = 204 Then
                    HDoF204 = 1
                    ElseIf Cells(i, 23) = 205 Then
                    HDoF205 = 1
                    End If

                    If Cells(i, 25) = 50 Then
                    HDoF50P = 1
                    ElseIf Cells(i, 25) = 51 Then
                    HDoF51P = 1
                    End If
                End If
            Else
            End If
        Else

        End If
    Else
    End If
Next i

If ActiveCell.Offset(0, -8) = "LDoF" Then
    If LDoF200 + LDoF225 = 2 Then
        ScoreQ5 = 2
    ElseIf LDoF50P + LDoF51P = 2 Then
        ScoreQ5 = 1
    Else
        ScoreQ5 = 0
    End If
Else
   If HDoF204 + HDoF205 = 2 Then
        ScoreQ5 = 2
    ElseIf HDoF50P + HDoF51P = 2 Then
        ScoreQ5 = 1
    Else
        ScoreQ5 = 0
    End If
End If

End Function

1 个答案:

答案 0 :(得分:0)

您正在为工作表编写自定义用户定义函数(也称为UDF)。如果您不确定如何完成自定义函数的某些方面,请查看本机工作表函数如何处理相同的问题。

您的函数(在某种程度上)在Q列中起作用,因为您使用Range.Offset property进行了硬编码的单元格范围引用。想象一下,如果你只能使用Q列中的SUMVLOOKUP函数会发生什么。它们可以在任何地方工作,因为你告诉他们在哪里可以找到带参数的数据。您的UDF应该以相同的方式工作。

一旦获得UDF结果,ActiveSheetActiveCell属性就不会简单地“关闭”。每次在工作簿中进行其他选择时,它们都会更改。这意味着您的UDF将根据新的ActiveCell property重新计算,这会因您使用Application.Volatile方法而受到激怒。此外,从A:O列中选择任何单元格都会导致错误,因为无法引用ActiveCell.Offset(0, -15)

将参数作为单元格和范围引用传递到UDF,就像使用任何本机工作表函数一样。如果您绝对需要引用UDf所在的工作表,则您引用的任何单元格的Range.Parent property都可以提供此功能。在紧要关头,这可以与UDF本身的Application.Caller属性结合使用。

您的叙述描述了在Q列中使用原始UDF,我将基于此对偏移列进行解释。

Function ScoreQ5(rngB As Range, rngI As Range, rngK As Range, _
                 rngW As Range, rngX As Range, rngY As Range, _
                 Optional strK As String = "5 - RedChemical_Threshold", _
                 Optional intX As Long = 200, _
                 Optional strI As String = "LDoF", _
                 Optional intWa As Long = 200, _
                 Optional intWb As Long = 225, _
                 Optional intWc As Long = 204, _
                 Optional intWd As Long = 205, _
                 Optional intYa As Long = 50, _
                 Optional intYb As Long = 51)

    Application.Volatile

    Dim LDoF200 As Integer
    Dim LDoF225 As Integer
    Dim HDoF204 As Integer
    Dim HDoF205 As Integer
    Dim LDoF50P As Integer
    Dim LDoF51P As Integer
    Dim HDoF50P As Integer
    Dim HDoF51P As Integer
    Dim current As Long
    Dim question As Long
    Dim LDoF As Integer
    Dim HDoF As Integer
    Dim i As Long

    current = 0
    LDoF200 = 0
    LDoF225 = 0
    HDoF204 = 0
    HDoF205 = 0
    LDoF50P = 0
    LDoF51P = 0
    HDoF50P = 0
    HDoF51P = 0
    question = 0
    LDoF = 0
    HDoF = 0

    With Application.Caller.Parent
        'cut the (possible) full column ranges down to size
        Set rngB = Intersect(rngB, rngB.Parent.UsedRange)
        Set rngI = Intersect(rngI, rngI.Parent.UsedRange)
        Set rngK = Intersect(rngK, rngK.Parent.UsedRange)
        Set rngW = Intersect(rngW, rngW.Parent.UsedRange)
        Set rngX = Intersect(rngX, rngX.Parent.UsedRange)
        Set rngY = Intersect(rngY, rngY.Parent.UsedRange)

        For i = 1 To rngB.Rows.Count
            If rngB.Cells(i) = rngB.Cells(Application.Caller.Row) Then  'B
                current = current + 1
                If StrComp(rngK.Cells(i), strK) = 0 Then  'K
                    question = question + 1
                    If rngX.Cells(i) = intX Then   'X
                        If StrComp(rngI.Cells(i), strI) = 0 Then  'I
                            LDoF = LDoF + 1

                            If rngW.Cells(i) = intWa Then  'W
                                LDoF200 = 1
                            ElseIf rngW.Cells(i) = intWb Then
                                LDoF225 = 1
                            End If

                            If rngY.Cells(i) = intYa Then  'Y
                                LDoF50P = 1
                            ElseIf rngY.Cells(i) = intYb Then
                                LDoF51P = 1
                            End If

                        Else
                            HDoF = HDoF + 1

                            If rngW.Cells(i) = intWc Then  'W
                                HDoF204 = 1
                            ElseIf rngW.Cells(i) = intWd Then
                                HDoF205 = 1
                            End If

                            If rngY.Cells(i) = intYa Then  'Y
                                HDoF50P = 1
                            ElseIf rngY.Cells(i) = intYb Then
                                HDoF51P = 1
                            End If
                        End If
                    Else
                    End If
                Else
                End If
            Else
            End If
        Next i
    End With

    If StrComp(rngI.Cells(i), strI) = 0 Then  'I
        If LDoF200 + LDoF225 = 2 Then
            ScoreQ5 = 2
        ElseIf LDoF50P + LDoF51P = 2 Then
            ScoreQ5 = 1
        Else
            ScoreQ5 = 0
        End If
    Else
       If HDoF204 + HDoF205 = 2 Then
            ScoreQ5 = 2
        ElseIf HDoF50P + HDoF51P = 2 Then
            ScoreQ5 = 1
        Else
            ScoreQ5 = 0
        End If
    End If

End Function
  

语法:
= ScoreQ5(B:B,I:I,K:K,W:W,X:X,Y:Y)

上述修改应该可以帮助您入门。我没有完整测试的样本数据和预期结果。如果您通过将收集的值与 2 进行比较而结束,我不完全确定为什么要循环遍历所有行。经过所有行之后,LDoF50P + LDoF51P之类的东西永远不会超过 2 吗?也许,布尔变量而不是整数类型变量可能更好地处理了这些变量。我已将一些比较常数作为可选参数传递给我。它们可以按原样使用,也可以通过添加其他值来修改参数。

我一直试图将完整列引用的使用改写为UDF中Worksheet.UsedRange property的范围。这使您可以在工作表上实现UDF时快速使用完整列引用,同时不会因处理大量空白单元而导致计算延迟。 tbh,我认为更多原生工作表函数可以对自己的单元格范围参数使用一些相同的预处理。