Well, I would have like to have contributed to Stack Overflow's VBA Documentation, specifically an array example but that section is full! So I will deposit the code here.
This code will take a vector, either a column vector or a row vector and convert to 1 dimensional array. So to be precise, the vector is in fact a 2 dimensional variant array where either the number of rows is one or the number of columns is one.
This finding arose from an exchange of comments on a solution by yowe3k (http://stackoverflow.com/users/6535336/yowe3k).
Option Explicit
Option Private Module
Private Function ConvertColumnOrRowVectorToOneDimensionalArray(vVector As Variant) As Variant
'* from an answer from yowe3k (http://stackoverflow.com/users/6535336/yowe3k) , transferred to documentation by S Meaden (http://stackoverflow.com/users/3607273/s-meaden)
Const sERROR_MSG_CORE As String = "Please pass a 2d variant array with one dimension of one element size"
If IsObject(vVector) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed an object)!" '* if you pass a Range, please pass Range.Value instead
If Not IsArray(vVector) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "!"
Dim lColumnLBound As Long: lColumnLBound = LBoundOERN(vVector, 2)
If lColumnLBound = -1 Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed a 1d array)!"
If Not (UBound(vVector, 1) - LBound(vVector, 1) = 0 Or UBound(vVector, 2) - LBound(vVector, 2) = 0) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed a matrix)!"
If UBound(vVector, 1) - LBound(vVector, 1) = 0 Then
ConvertColumnOrRowVectorToOneDimensionalArray = Application.Transpose(Application.Transpose(vVector))
Else
ConvertColumnOrRowVectorToOneDimensionalArray = Application.Transpose(vVector)
End If
End Function
Private Function LBoundOERN(v, n) As Long
LBoundOERN = -1
On Error Resume Next
LBoundOERN = LBound(v, n)
End Function
'***************************************************************
'* TESTS - also illustrative as to how to call the function
'***************************************************************
Private Sub TestConvertColumnOrRowVectorToOneDimensionalArray_All()
TestConvertColumnOrRowVectorToOneDimensionalArray_NonErrors
TestConvertColumnOrRowVectorToOneDimensionalArrayTestErrorThrowing
End Sub
Private Sub TestConvertColumnOrRowVectorToOneDimensionalArray_NonErrors()
Sheet1.Cells(1, 1) = "foo" '* set up the data
Sheet1.Cells(2, 1) = "bar" '* in a vertical block of three
Sheet1.Cells(3, 1) = "baz" '* cells
Dim v1DFromColumnVector
v1DFromColumnVector = ConvertColumnOrRowVectorToOneDimensionalArray(Sheet1.Range("A1:A3").Value)
Debug.Assert v1DFromColumnVector(1) = "foo" '* now
Debug.Assert v1DFromColumnVector(2) = "bar" '* one-
Debug.Assert v1DFromColumnVector(3) = "baz" '* dimensional
Sheet1.Cells(1, 3) = "foo" '* set up the data
Sheet1.Cells(1, 4) = "bar" '* in a horizontal block of three
Sheet1.Cells(1, 5) = "baz" '* cells
Dim v1DFromRowVector
v1DFromRowVector = ConvertColumnOrRowVectorToOneDimensionalArray(Sheet1.Range("C1:E1").Value)
Debug.Assert v1DFromRowVector(1) = "foo" '* now
Debug.Assert v1DFromRowVector(2) = "bar" '* one-
Debug.Assert v1DFromRowVector(3) = "baz" '* dimensional
End Sub
Private Sub TestConvertColumnOrRowVectorToOneDimensionalArrayTestErrorThrowing()
On Error Resume Next '* On Error ... resets the error object and its properties
Debug.Assert Err.Number = 0
ConvertColumnOrRowVectorToOneDimensionalArray Sheet1.Cells(1, 1)
Debug.Assert Err.Number = vbObjectError
Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed an object)!"
On Error Resume Next '* On Error ... resets the error object and its properties
Debug.Assert Err.Number = 0
ConvertColumnOrRowVectorToOneDimensionalArray "FOO"
Debug.Assert Err.Number = vbObjectError
Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size!"
On Error Resume Next '* On Error ... resets the error object and its properties
Dim vOneDim(1 To 3) As Variant
vOneDim(1) = "luke": vOneDim(2) = "leia": vOneDim(3) = "han":
ConvertColumnOrRowVectorToOneDimensionalArray vOneDim
Debug.Assert Err.Number = vbObjectError
Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a 1d array)!"
On Error Resume Next '* On Error ... resets the error object and its properties
Debug.Assert Err.Number = 0
ConvertColumnOrRowVectorToOneDimensionalArray Sheet1.Range("A1:B2").Value
Debug.Assert Err.Number = vbObjectError
Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a matrix)!"
On Error Resume Next '* On Error ... resets the error object and its properties
Debug.Assert Err.Number = 0
ConvertColumnOrRowVectorToOneDimensionalArray [{"Jonh","Snow","President";"Ygritte","Wild","Vice-President"}]
Debug.Assert Err.Number = vbObjectError
Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a matrix)!"
End Sub
No comments:
Post a Comment