Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Changing a two-dimensional, one row array to one-dimensional
The typical way to accomplish the above diseminated in these newsgroups
has been myArray2 = Application.Transpose(Application.Transpose(myArra y1)) Less typical, but equally effective, is myArray2 = Application.Index(myArray1, 1, 0) Both of these methods have the following limitations: they don't work on large arrays (i.e., arrays of more than 65536 elements in Excel2007; arrays of much fewer elements in earlier versions); and they both produce a myArray2 of the Variant() type, even if myArray1 is of a different built-in type. The following function avoids those limitations (watch for wordwrap). It invokes the function ArrayDimensions, which is freely downloadable with the file at http://home.pacbell.net/beban, and which is also included below for convenience. Function ChangeToOneD(inputArray) If Not IsArray(inputArray) Then GoTo ErrMsg ElseIf TypeOf inputArray Is Range Then GoTo ErrMsg ElseIf ArrayDimensions(inputArray) < 2 Or UBound(inputArray) 1 Then GoTo ErrMsg Else Dim arrOut x = TypeName(inputArray) If x = "Object()" Then ReDim arrOut(LBound(inputArray,2) To UBound(inputArray,2)) As Object For i = LBound(inputArray, 2) To UBound(inputArray, 2) Set arrOut(i) = inputArray(1, i) Next ChangeToOneD = arrOut Exit Function End If Select Case x Case "Boolean()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Boolean Case "Byte()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Byte Case "Currency()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Currency Case "Date()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Date Case "Double()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Double Case "Integer()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Integer Case "Long()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Long Case "Single()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Single Case "String()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As String Case "Variant()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Variant Case Else GoTo ErrMsg End Select For i = LBound(inputArray, 2) To UBound(inputArray, 2) arrOut(i) = inputArray(1, i) Next ChangeToOneD = arrOut End If Exit Function ErrMsg: Msg = "The function accepts only 2-dimensional, single row VBA arrays of a built-in type." MsgBox Msg, 16 End Function Function ArrayDimensions(InputArray As Variant) 'This function returns the number of dimensions 'of the input array. It contains a loop that was 'suggested in the .programming group by Dana DeLouis. 'Declare variables Dim arr1, i As Integer, z As Long If Not TypeName(InputArray) Like "*()" Then Msg = "#ERROR! The function accepts only arrays." If TypeOf Application.Caller Is Range Then ArrayDimensions = Msg Else MsgBox Msg, 16 End If Exit Function End If On Error Resume Next 'Loop until an error occurs i = 1 Do z = UBound(InputArray, i) i = i + 1 Loop While Err = 0 'Reset the error value for use with other procedures Err = 0 'Return the number of dimensions ArrayDimensions = i - 2 End Function Alan Beban |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Changing a two-dimensional, one row array to one-dimensional
It is better to break up complicated If statements into smaller pieces. Here
is code that will work. It is pretty easy to understand this code. Sub Test() 'Cell A1 contains drop down list selection If Range("A1") = "American Express" Then CCNumber = 15 Else CCNumber = 16 End If If Len(EnteredNumber) < CCNumber Then MsgBox ("Invalid Credit Card Number") Else 'enter you code here End If End Sub "Alan Beban" wrote: The typical way to accomplish the above diseminated in these newsgroups has been myArray2 = Application.Transpose(Application.Transpose(myArra y1)) Less typical, but equally effective, is myArray2 = Application.Index(myArray1, 1, 0) Both of these methods have the following limitations: they don't work on large arrays (i.e., arrays of more than 65536 elements in Excel2007; arrays of much fewer elements in earlier versions); and they both produce a myArray2 of the Variant() type, even if myArray1 is of a different built-in type. The following function avoids those limitations (watch for wordwrap). It invokes the function ArrayDimensions, which is freely downloadable with the file at http://home.pacbell.net/beban, and which is also included below for convenience. Function ChangeToOneD(inputArray) If Not IsArray(inputArray) Then GoTo ErrMsg ElseIf TypeOf inputArray Is Range Then GoTo ErrMsg ElseIf ArrayDimensions(inputArray) < 2 Or UBound(inputArray) 1 Then GoTo ErrMsg Else Dim arrOut x = TypeName(inputArray) If x = "Object()" Then ReDim arrOut(LBound(inputArray,2) To UBound(inputArray,2)) As Object For i = LBound(inputArray, 2) To UBound(inputArray, 2) Set arrOut(i) = inputArray(1, i) Next ChangeToOneD = arrOut Exit Function End If Select Case x Case "Boolean()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Boolean Case "Byte()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Byte Case "Currency()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Currency Case "Date()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Date Case "Double()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Double Case "Integer()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Integer Case "Long()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Long Case "Single()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Single Case "String()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As String Case "Variant()" ReDim arrOut(LBound(inputArray, 2) To UBound(inputArray, 2)) As Variant Case Else GoTo ErrMsg End Select For i = LBound(inputArray, 2) To UBound(inputArray, 2) arrOut(i) = inputArray(1, i) Next ChangeToOneD = arrOut End If Exit Function ErrMsg: Msg = "The function accepts only 2-dimensional, single row VBA arrays of a built-in type." MsgBox Msg, 16 End Function Function ArrayDimensions(InputArray As Variant) 'This function returns the number of dimensions 'of the input array. It contains a loop that was 'suggested in the .programming group by Dana DeLouis. 'Declare variables Dim arr1, i As Integer, z As Long If Not TypeName(InputArray) Like "*()" Then Msg = "#ERROR! The function accepts only arrays." If TypeOf Application.Caller Is Range Then ArrayDimensions = Msg Else MsgBox Msg, 16 End If Exit Function End If On Error Resume Next 'Loop until an error occurs i = 1 Do z = UBound(InputArray, i) i = i + 1 Loop While Err = 0 'Reset the error value for use with other procedures Err = 0 'Return the number of dimensions ArrayDimensions = i - 2 End Function Alan Beban |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
3 dimensional array | Excel Programming | |||
Create One-Dimensional Array from Two-Dimensional Array | Excel Programming | |||
Do I need a two dimensional array for this? | Excel Programming | |||
add to two dimensional array | Excel Programming | |||
2 Dimensional Array | Excel Programming |