可以处理大于 255 个字符的自定义 INDEX 函数

Question

我正在尝试将 Application.Index 函数与变体 2D 数组一起使用，该变体包含一些具有 >255 个文本字符的元素。这会导致 Variant/Integer Type Type Mismatch 错误。我也无法使用 Application.Transpose，因为达到了 >255 个字符的限制。

有没有人Custom INDEX UDFunction可以处理超过 255 个字符的文本来克服这个限制？

例如

片段代码如下所示：

........
........
For j = 1 to NoOfSlides
    A = (j - 1) * (nRw * 2) + 1
    B = IIf(A >= UBound(Arr, 1), UBound(Arr, 1), (A + (nRw * 2)) - 1)
    If B > UBound(Arr, 1) Then B = UBound(Arr, 1)
    ab_Rng = Evaluate("row(" & A & ":" & B & ")")
    TmpArr(j) = Application.Index(Arr, ab_Rng, Array(1, 2))  ' Type Mismatch Error
    With oPres
        Set oSlide = .slides("Slide0_ABC").Duplicate
        oSlide.moveto toPos:=.slides.Count
        With oSlide
        ....
        End With

        If getDimensions(TmpArr(j))<2 Then 
            TmpArr(j) = Application.Transpose(TransposeDim(TmpArr(j)) )    ' Error
        End If
        For y = LBound(TmpArr(j), 1) To UBound(TmpArr(j), 1)
        .....
        Next y
    End With
Next j
........
........

Function getDimensions(var As Variant) As Long
    On Error GoTo Err

    Dim i As Long
    Dim tmp As Long

    i = 0
    Do While True
        i = i + 1
        tmp = UBound(var, i)
    Loop

Err:
    getDimensions = i - 1
    On Error GoTo 0
    Err.Clear

End Function


Function TransposeDim(v As Variant) As Variant
' Convert 1D Array to 2D Array (1 -Based)
    Dim x As Long, y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant

    on error resume next
    Xupper = UBound(v, 2)
    if err.number <>0 then
        Redim Preserve v(1 to ubound(v), 1 to 1)
       Xupper = UBound(v, 2)   
    endif
    on error goto 0

    Yupper = UBound(v, 1)

    ReDim tempArray(1 To Xupper, 1 To Yupper)
    For x = 1 To Xupper
        For y = 1 To Yupper
            tempArray(x, y) = v(y, x)
        Next y
    Next x

    TransposeDim = tempArray
End Function

编辑： 这里有一个 Sample.xlsm file and a Sample PPT Template 供任何人阅读。

Answer 1

Dim a(1 To 2, 1 To 2) As String
Dim o As String

a(1, 2) = "testing " & String(255, "x")

o = Application.Index(a, 1, 2)

Debug.Print Len(o)

为了支持我的评论，您没有正确使用 index。我认为您需要使用 Array(1, 2)(0) 和 Array(1, 2)(1)

Answer 2

有趣的是，虽然很奇怪，但我发现 Arr 被定义为变体并拉入范围数据。例如

Arr = Sheet1.Range("A3:B8").Formula    ' a Variant/Variant array

INDEX、TRANSPOSE、MATCH 等将不起作用并导致 Type MisMatch Error 达到 >255 个字符的限制。我认为它在内部使用 Integer index，因此保持 255 个字符的限制。

但是，如果我将数组 Arr 定义为 String:

' Define Arr as a String
ReDim Arr(1 To UBound(VarRng.Formula, 1), 1 To UBound(VarRng.Formula, 2)) As String

For x = LBound(VarRng.Formula, 1) To UBound(VarRng.Formula, 1)
     For y = LBound(VarRng.Formula, 2) To UBound(VarRng.Formula, 2)
        Arr(x, y) = CStr(VarRng.Formula(x, y))
    Next y
Next x

'...然后 INDEX、TRANSPOSE、MATCH 等将正常工作，即使数组中有 >255 个字符。

' Define Arr as a String
ReDim Arr(1 To UBound(VarRng.Formula, 1), 1 To UBound(VarRng.Formula, 2)) As String

For x = LBound(VarRng.Formula, 1) To UBound(VarRng.Formula, 1)
     For y = LBound(VarRng.Formula, 2) To UBound(VarRng.Formula, 2)
        Arr(x, y) = CStr(VarRng.Formula(x, y))
    Next y
Next x
`Arr` is now a Variant/String
'....
'....
For j = 1 to NoOfSlides
    A = (j - 1) * (nRw * 2) + 1
    B = IIf(A >= UBound(Arr, 1), UBound(Arr, 1), (A + (nRw * 2)) - 1)
    If B > UBound(Arr, 1) Then B = UBound(Arr, 1)
    ab_Rng = Evaluate("row(" & A & ":" & B & ")")

    TmpArr(j) = Application.Index(Arr, ab_Rng, Array(1, 2))
'....
Next j

Sample.xlsm and PPT Sample Template.pptx

希望这对您有所帮助。

可以处理大于 255 个字符的自定义 INDEX 函数

Custom INDEX function that can handle greater than 255 Characters

excel

vba

user-defined-functions

transpose

type-mismatch