时间戳

首页 > 解决方案 > 为什么我的函数在子程序没有失败的地方失败？

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

问题描述

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

  1. Dictionary使用对象在数组中查找重复项
  2. 如果在数组中找到重复项，则提供该重复项的运行计数。

以下是我的 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

我究竟做错了什么？

标签： excelvbafunctiondictionarymultidimensional-array

解决方案

在我看来RunningCntOfOccsInArr = OutPut_Array(RowIndex,1)只是返回For Next循环的最后一个值。我建议通过 Variant 数据类型将函数重新定义为数组并将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

推荐阅读