Question

我有一个执行以下操作的子过程：

使用Dictionary对象在数组中查找重复项
如果在阵列中找到重复项，请提供该重复项的运行计数。

以下是我的潜艇返回的示例：

Sub完全按预期工作，因此我将其转换为函数，以便在正在使用的程序的一部分中使用它，但是我无法让函数正确返回结果。

下面是我的Sub起作用：

Sub GetRuningCounts()
  Dim dict As Object
  Dim i As Long
  Dim Source_Array, OutPut_Array

  Application.ScreenUpdating = False

  Set dict = CreateObject("Scripting.Dictionary")

  Source_Array = Sheet1.Range("A2").CurrentRegion.Value2

  ReDim OutPut_Array(LBound(Source_Array, 1) To UBound(Source_Array, 1), 1 To 1)
  'On Error Resume Next
  For i = LBound(Source_Array, 1) To UBound(Source_Array, 1)
     dict(Source_Array(i, 21)) = dict(Source_Array(i, 21)) + 1
     OutPut_Array(i, 1) = dict(Source_Array(i, 21))
  Next i

  Sheet2.Range("A1").Resize(UBound(OutPut_Array, 1)).Value = OutPut_Array

End Sub

我的UDF：

Function RunningCntOfOccsInArr(ByRef Source_Array As Variant, ByRef RowIndex As Long,  ByVal ColIndex As Integer) As Long

 Dim ditc As Object
 Dim RowIndex As Long
 Dim OutPut_Array As Variant

    If IsArray(Source_Array) = False Then
        Exit Function

    ElseIf IsArrayAllocated(Source_Array) = False Then
        Exit Function

    ElseIf (ColIndex < LBound(Source_Array, 2)) Or (ColIndex > UBound(Source_Array, 2)) Then
        Exit Function

    End If

 Set dict = CreateObject("Scripting.Dictionary")

    ReDim OutPut_Array(LBound(Source_Array, 1) To UBound(Source_Array, 1), 1 To 1)

    For RowIndex = LBound(Source_Array, 1) To UBound(Source_Array, 1)
        dict(Source_Array(RowIndex, ColIndex)) = dict(Source_Array(RowIndex, ColIndex)) + 1
        OutPut_Array(RowIndex, 1) = dict(Source_Array(RowIndex, ColIndex))
        RunningCntOfOccsInArr = OutPut_Array(RowIndex,1)
    Next RowIndex

End Function

Sub中的功能示例：

Sub Test_GetRunningCountss()
  Dim i As Long
  Dim Data_Array 

  Application.ScreenUpdating = False

  Data_Array = Sheet1.Range("A2").CurrentRegion.Value2
    For i = LBound(Data_Array, 1) To UBound(Data_Array, 1)
        If RunningCntOfOccsInArr(Data_Array, i, 21) Mod 2 = 0 Then 
              Sheet2.Cells(i, 2).Value2 = "Even"
        Else
              Sheet2.Cells(i, 2).Value2 = "Odd"
        End If

    Next i

End Sub

我在做什么错了？

Answer 1

在我看来，RunningCntOfOccsInArr = OutPut_Array(RowIndex,1)仅返回For Next循环的最后一个值。我建议您通过Variant数据类型将您的函数重新定义为Array，并将For Next循环更改为

Function RunningCntOfOccsInArr(ByRef Source_Array As Variant, ByRef RowIndex As Long,  ByVal ColIndex As Integer) As Variant
'....Other Code Here....
For RowIndex = LBound(Source_Array, 1) To UBound(Source_Array, 1)
    dict(Source_Array(RowIndex, ColIndex)) = dict(Source_Array(RowIndex, ColIndex)) + 1
    OutPut_Array(RowIndex, 1) = dict(Source_Array(RowIndex, ColIndex))
Next RowIndex
RunningCntOfOccsInArr = OutPut_Array

在Sub调用中，您需要定义一个数组来保存您的函数值（因此不会每次都调用它）和一个嵌套循环来遍历那些返回的值。

Sub Test_GetRunningCountss()
  Dim i As Long
  Dim i2 as Long
  Dim Data_Array
  Dim returnArray() As Variant

  Application.ScreenUpdating = False

  Data_Array = Sheet1.Range("A2").CurrentRegion.Value2
    For i = LBound(Data_Array, 1) To UBound(Data_Array, 1)
        returnArray = RunningCntOfOccsInArr(Data_Array, i, 21)
        For i2 = LBound(returnArray) to UBound(returnArray)
            If returnArray(i2, 1) Mod 2 = 0 Then 
                  Sheet2.Cells(i2, 2).Value2 = "Even"
            Else
                  Sheet2.Cells(i2, 2).Value2 = "Odd"
            End If
        Next i2
    Next i
End Sub

为什么我的函数在没有子例程的地方失败？

1 个答案: