Excel VBA将二维数组转换为一维

我不是math，但我需要在VBA中解决一些映射函数。 我有string数组Divisions，由表单上的checkbox填充（数组由string或零填充，如图片）。 我需要find一些函数将我的数组（在左边，总是3×4维）转换为右边的数组（nx1维）。 这里是例子： 你有什么想法？ 它在VBA中是否存在某种映射函数，可以做什么，我希望如何？ 谢谢

Answer 1

3个简单的循环会做：

Option Explicit Option Base 1 Sub Test() Dim arr, vec() As String, dmy As String Dim r1 As Integer, r2 As Integer, r3 As Integer, counter As Integer arr = Range("A1:D3").Value For r1 = 1 To 4 For r2 = 1 To 4 For r3 = 1 To 4 dmy = Join(Array(arr(1, r1), arr(2, r2), arr(3, r3), " ")) If InStr(dmy, "0") = 0 Then counter = counter + 1 ReDim Preserve vec(counter) vec(counter) = dmy End If Next Next Next Range("G1").Resize(counter, 1).Value = Application.WorksheetFunction.Transpose(vec) End Sub 

Answer 2

不幸的是，我不认为有这样的function。 你将不得不自己写。 或者，你可以看看这里http://www.cpearson.com/excel/vbaarrays.htm

Answer 3

在OP的澄清后编辑

你可以如下所示：

 Option Explicit Sub main() Dim myMatrix(1 To 3, 1 To 4) As Variant Dim myArray As Variant Dim i As Long, j As Long, k As Long, nRows As Long, nCols As Long 'fill Matrix with some values myMatrix(1, 1) = 1: myMatrix(1, 2) = 2: myMatrix(1, 3) = 3: myMatrix(1, 4) = 4 myMatrix(2, 1) = 5: myMatrix(2, 2) = 6: myMatrix(2, 3) = 7: myMatrix(2, 4) = 8 myMatrix(3, 1) = 9: myMatrix(3, 2) = 10: myMatrix(3, 3) = 11: myMatrix(3, 4) = 12 myArray = GetArray(myMatrix) '<~~ fill Array MsgBox GetArrayItem(myArray, 2, 3) '<~~ get Array item corresponding to Matrix(2,3) MsgBox GetMatrixItem(myMatrix, 7) '<~~ get Matrix item corresponding to Array(7) End Sub Function GetArrayItem(myArray As Variant, i As Long, j As Long) As Variant 'mapping from Matrix to array Dim k As Long k = (i - 1) * 4 + j '<~~ equivalent array index given matrix indexes GetArrayItem = myArray(k) End Function Function GetMatrixItem(myMatrix() As Variant, k As Long) As Variant 'mapping from Array to Matrix Dim i As Long, j As Long, nCols As Long nCols = UBound(myMatrix, 2) - LBound(myMatrix, 2) + 1 '<~~get Matrix columns number i = k Mod nCols - 1 '<~~ matrix row index given array index j = k - (i - 1) * nCols '<~~ matrix column index given array index GetMatrixItem = myMatrix(i, j) End Function Function GetArray(myMatrix() As Variant) As Variant 'returns an Array filled with a Matrix content Dim myArray() As Variant Dim i As Long, j As Long, k As Long, nRows As Long, nCols As Long nRows = UBound(myMatrix, 1) - LBound(myMatrix, 1) + 1 '<~~get Matrix rows number nCols = UBound(myMatrix, 2) - LBound(myMatrix, 2) + 1 '<~~get Matrix columns number ReDim myArray(1 To nRows * nCols) '<~~dim Array accordingly to Matrix dimensions 'loop through Matrix elements to fill Array For i = 1 To nRows For j = 1 To nCols myArray((i - 1) * 4 + j) = myMatrix(i, j) Next j Next i GetArray = myArray '<~~return array End Function 

Answer 4

几乎等于Jochen的答案。 在这里，我检查数组的元素是否为非零，然后组合它们来检查string的长度。 如果它等于3，则打印，否则继续。

 Option Explicit Sub test() Dim base(2, 3), ip As Range, op As Range, output(64), i As Integer, j As Integer, k As Integer, l As Integer, temp As String l = 0 Set ip = Application.InputBox(Prompt:="Please select a first cell of input range", Title:="Specify Input range", Type:=8) Set op = Application.InputBox(Prompt:="Please select a first cell of output range", Title:="Specify Output range", Type:=8) For i = 0 To 2 For j = 0 To 3 base(i, j) = ip.Offset(i, j).Value Next j Next i For i = 0 To 3 If base(0, i) <> 0 Then For j = 0 To 3 If base(1, j) <> 0 Then For k = 0 To 3 If base(2, k) <> 0 Then temp = base(0, i) & base(1, j) & base(2, k) If Len(temp) = 3 Then output(l) = temp op.Offset(l, 0) = output(l) l = l + 1 temp = "" End If End If Next k End If Next j End If Next i End Sub