Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA: completing a matrix

I have a 3 by 3 matrix, where elements (1,1), (2,1), (2,2), (3,1), (3,2), (3,3) are given:

X   .   .
X   X   .
X   X   X

I need to write a program that writes out the missing elements, where (1,2)=(2,1), (1,3)=(3,1) and (2,3)=(3,2). I have written the following code:

Function kiegeszito(a)
    For i = 1 To 3
        For j = 1 To 3
            If i < j Then
                a(i, j) = a(j, i)
            Else        
                a(i, j) = a(i, j)
            End If
        Next j
    Next i

    kiegeszito = a
End Function

However, this does not seem to work, could anybody help me why is this not working?

like image 589
Levente Kim Avatar asked Feb 27 '21 14:02

Levente Kim


People also ask

How do you declare a dynamic array in VBA?

Create a Dynamic Array in VBA First, declare an array with its name. After that, the elements count left the parentheses empty. Now, use the ReDim statement. In the end, specify the count of elements you want to add to the array.


3 Answers

Just remove the Else condition:

Function kiegeszito(a)
    For i = 1 To 3
        For j = 1 To 3
            If i < j Then a(i, j) = a(j, i)
        Next j
    Next i

    kiegeszito = a
End Function
like image 171
ZygD Avatar answered Oct 19 '22 00:10

ZygD


Get twin data in 2-dim matrix avoiding extra n*(n-1)/2 condition checks

The following approach

  • reduces the number of unnecessary condition checks by incrementing the 2nd loop starts
  • accepts any wanted base of 2-dim data:
Sub CompleteMatrix(ByRef data)
'count row|=column elements
Dim cnt As Long: cnt = UBound(data) - LBound(data) + 1

'fill missing twin data (identified by inverted indices)
Dim i As Long, j As Long
For i = LBound(data) To cnt - 1
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'next column starts from incremented row index
    '(thus avoiding n*(n-1)/2 IF-conditions)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For j = i + 1 To UBound(data, 2)
        data(i, j) = data(j, i)     ' assign twin data
    Next j
Next i
End Sub

An example call creating e.g. a 1-based 2-dim datafield array might be

Sub ExampleCall()
    Dim v: v = Tabelle3.Range("A1:C3").Value
    CompleteMatrix v
End Sub

Further link

A practical example using such a mirrored array might be a distance array; a related post demonstrates how to apply the FilterXML() function thereon.

like image 4
T.M. Avatar answered Oct 18 '22 22:10

T.M.


Fill Array

  • Using a method (fillArray) you could modify the array 'in place':

The Code

Option Explicit

Sub fillArrayTEST()
    Dim Data As Variant: Data = Range("A1:C3").Value
    debugPrint2D Data
    fillArray Data
    debugPrint2D Data
End Sub

Sub fillArray(ByRef Data As Variant)
    Dim cCount As Long: cCount = UBound(Data, 2)
    Dim i As Long, j As Long
    For i = 1 To UBound(Data, 1)
        For j = 1 To cCount
            If i < j Then Data(i, j) = Data(j, i)
        Next j
    Next i
End Sub

Sub debugPrint2D(ByVal Data As Variant)
    Dim i As Long, j As Long
    For i = LBound(Data, 1) To UBound(Data, 1)
        For j = LBound(Data, 2) To UBound(Data, 2)
            Debug.Print "[" & i & "," & j & "]", Data(i, j)
        Next j
    Next i
End Sub

A Homage to T.M.'s Brilliant Solution

Sub completeMatrix(ByRef Data As Variant)
    Dim rLower As Long: rLower = LBound(Data, 1)
    Dim cLower As Long: cLower = LBound(Data, 2)
    Dim iDiff As Long: iDiff = cLower - rLower
    Dim cStart As Long: cStart = iDiff + 1
    Dim cUpper As Long: cUpper = UBound(Data, 2)
    Dim r As Long, c As Long
    For r = rLower To UBound(Data, 1) - rLower
        For c = cStart + r To cUpper
            Data(r, c) = Data(c - iDiff, r + iDiff)
        Next c
    Next r
End Sub

Sub completeMatrixTEST()
    Dim Data As Variant: ReDim Data(0 To 2, 2 To 4)
    Data(0, 2) = 1
    Data(1, 2) = 2
    Data(1, 3) = 3
    Data(2, 2) = 4
    Data(2, 3) = 5
    Data(2, 4) = 6
    debugPrint2D Data
    completeMatrix Data
    'Range("G1").Resize(UBound(Data, 1) - LBound(Data, 1) + 1, _
        UBound(Data, 2) - LBound(Data, 2) + 1).Value = Data
    Debug.Print
    debugPrint2D Data
End Sub
like image 1
VBasic2008 Avatar answered Oct 18 '22 22:10

VBasic2008