简体   繁体   中英

VBA function causing runtime error 13 while returning array in excel 2016 but not in office 365?

I have a function that reads data in an tab and returns it as an 1D array:

Public Function OneDimension(arr)
    OneDimension = Application.Transpose(Application.Transpose(arr))
End Function

the function is called when the form is opened:

Set actionDict = New Scripting.Dictionary
numArrCols = Data.Columns.Count - 1
ReDim arr(1 To numArrCols) 'empty array

For Each rw In Data.rows
    id = "" & rw.Cells(1).Value
    If Not actionDict.Exists(id) Then
        actionDict.Add id, New Collection 'new key: add key and empty collection
    End If
    actionDict(id).Add OneDimension(rw.Cells(2).Resize(1, numArrCols).Value) 'add the row value as 1D array
Next rw

The data looks like this:

user id name date answer amount comments completed helper
1 test,t 05/22/2022 yes 0.01 something No 144687

with the formula

helper = user id & date

user id is a text field, and date is stored as mm/dd/yyyy , when I run it with Office 365 it seems fine, but when my boss ran it with excel 2016 it gave this error:

runtime error 13 type mismatch

with this in the debugger:

调试器错误

What could be causing this?

One-Row Range to 1D Array

  • Why use one-liners with limited functionality? They are shorter but usually not faster.

  • In your sub, you could use:

     actionDict(id).Add OneDaRow(rw.Cells(2).Resize(1, numArrCols))

The Function

Function OneDaRow(ByVal RowRange As Range) As Variant
    
    Dim Data As Variant ' 2D one-based one-row array
    Dim c As Long
    
    With RowRange.Rows(1)
        c = .Columns.Count
        If c = 1 Then ' one cell
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
        Else ' multiple cells
            Data = .Value
        End If
    End With
        
    Dim Arr As Variant: ReDim Arr(1 To c) ' 1D one-based array
    
    For c = 1 To c
        Arr(c) = Data(1, c)
    Next c
    
    OneDaRow = Arr

End Function

A Function Test

Sub OneDaRowTEST()
    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Debug.Print Join(OneDaRow(rg), vbLf)
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM