Excel VBA二次元配列を一次元に移動

Question

私は数学ではありませんが、私はVBAでいくつかのマッピング関数を解決する必要があります。 私は文字列配列Divisionsを持っています。これは、フォーム上のチェックボックスで塗りつぶされています（配列は、文字列または0で塗りつぶされています）。私は配列を左（常に3x4次元）から右（nx1次元）の配列に変換する関数を見つける必要があります。ここに例があります： ご意見はありますか？ VBAにはある種のマップ機能が存在しますか？これは私が望むものですか？ありがとうございます

Answer 1

残念ながら、私はこのような機能はないと思います。あなた自身でそれを書かなければなりません。 また、あなたがここにhttp://www.cpearson.com/excel/vbaarrays.htm OPの明確化後に編集

Answer 2

を見てみることができますあなたのように行くことができるが、以下：

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 3

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 4

ほぼ等しいですJochenの答えに。ここでは、配列の要素が非ゼロであるかどうかをチェックし、それらを組み合わせて文字列の長さをチェックします。 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