Function Join2DArray(ParamArray arrays())
Dim arr(), aSub, tmp
Dim lRs As Long, lCs As Long, lR As Long, lC As Long
Dim n As Long, m As Long, i As Long, bChk As Boolean
On Error Resume Next
For i = 0 To UBound(arrays)
aSub = arrays(i)
n = UBound(aSub, 1) - LBound(aSub, 1) + 1
lRs = lRs + n
m = UBound(aSub, 2) - LBound(aSub, 2) + 1
If lCs < m Then lCs = m
Next
ReDim arr(1 To lCs, 1 To lRs)
n = 0: m = 0
For i = 0 To UBound(arrays)
aSub = arrays(i)
For lR = LBound(aSub, 1) To UBound(aSub, 1)
bChk = False
n = n + 1
For lC = LBound(aSub, 2) To UBound(aSub, 2)
tmp = aSub(lR, lC)
Select Case VarType(tmp)
Case 0 To 1: arr(lC, n) = vbNullString
Case 2 To 7: arr(lC, n) = tmp
Case 8
If IsNumeric(tmp) Then
arr(lC, n) = "'" & tmp
Else
arr(lC, n) = tmp
End If
End Select
If Len(CStr(tmp)) Then bChk = True
Next
If bChk = False Then n = n - 1
Next
Next
If n Then
ReDim Preserve arr(1 To lCs, 1 To n)
Join2DArray = Transpose2DArray(arr)
End If
End Function
Function Transpose2DArray(ByVal arr2D)
Dim arr(), aTemp
Dim lR As Long, lC As Long
On Error Resume Next
aTemp = arr2D
ReDim arr(LBound(aTemp, 2) To UBound(aTemp, 2), LBound(aTemp, 1) To UBound(aTemp, 1))
For lR = LBound(aTemp, 1) To UBound(aTemp, 1)
For lC = LBound(aTemp, 2) To UBound(aTemp, 2)
arr(lC, lR) = aTemp(lR, lC)
Next
Next
Transpose2DArray = arr
End Function
