Code now thoroughly revised and tested.
Acting on a suggestion by @Zizi64 Subs and a demo for In-Situ-Flipping were added. [/b] The focus as I see it is on the direct passing of flipped arrays to standard functions, however.
Now and then we have to search an array for a match using MATCH or VLOOKUP e.g. and need to do so in reverse order: bottom up or right to left.
Solutions I saw or designed myself used either complicated formulas with tricky constructs within OFFSET or relied on helper columns (/rows/arrays).
A few years ago I sketched in BASIC a few functions capable of flipping arrays to prepare them to get passed to a SEARCH, VLOOKUP or HLOOKUP call working then as if it processed the original array in reverse order. Because of recent demand I polished the code a bit and supply it here now. It is contained in the following demo, but I also post it in plain text below. Enjoy it.
The code published first contained a few useless statement blocks and some misleading comments. The erratic statements wouldn't do harm. Nonetheless I recommend to replace the old code with the newer version. For internal (inside BASIC) application of the functions the limitation to arrays with 1-based indexes was resolved.
The reworked code is to find below. It also is contained in the new attachment, where a demo was added showing how to match backwards and how to get VLOOKUP to return values from columns left of the lookup column.
Code: Select all
REM ***** BASIC *****
REM Module Standard.reArrange
REM Module Version 0.1 of 2017-09-27 by Wolfgang Jäger based on older sketches
REM Module Version 0.2 of 2017-10-01 by Wolfgang Jäger
REM Useless (but not evil-doing) parts removed, comments enhanced and rectified
REM Functions made independent of 1-based indexing.
REM Module Version 0.2.1 of 2017-10-01 by Wolfgang Jäger
REM Bugfixes concerning For loops
Option Explicit
REM As a kind of "horizontalFlipString(pString)" added here though not related to 2D-flips
Function reverseString(pS As String) As String
If pS="" Then
reverseString = ""
Exit Function
End If
Dim n As Long, k As Long
n = Len(pS)
Dim cA(1 To n) As String
For k = 0 To n - 1
cA(k+1) = Mid(pS, n - k, 1)
Next k
pS = Join(cA, "")
reverseString = pS
End Function
REM All the arrays passed to these functions need to be 2D as all arrays passed via parameters by calls from Calc formulas are anyway.
REM Calls from user code might have also use for differently dimensional arrays. A respective variant is not yet implemented.
REM However, the functions do not insist on the array indexes being 1-based.
Function centralFlip2D(pRange)
REM The function is applicable to any m x n - range where m, n are positive integers, the value 1 allowed in both places.
If NOT IsArray(pRange) Then
Dim hRange(1 To 1, 1 To 1)
hRange(1,1) = pRange
pRange = hRange
EndIf
Dim aNum As Long, bNum as Long, a As Long, b As Long
Dim ml As Long, mu As Long, nl As Long, nu As Long, m As Long, n As Long
Dim h
ml = Lbound(pRange(),1) : mu = Ubound(pRange(),1) : m = mu - ml +1
nl = Lbound(pRange(),2) : nu = Ubound(pRange(),2) : n = nu -nl + 1
aNum = m \ 2
REM The upper half and the lower half of the array are mirrored now over the center excluding the middle row if one exists at all.
bNum = n
For a = ml To ml + aNum - 1
For b = nl To nl + bNum - 1
h = pRange(a, b)
pRange(a, b) = pRange(mu+ml-a, nu+nl-b)
pRange(mu+ml-a, nu+nl-b) = h
Next b
Next a
REM Only in case of an odd number of rows two half rows need mirroring one onto the other.
REM Including this in the above loop for 'a' would mirror twice and thus lead back to the original middle row.
REM A rejected alternative was to limit the loop for b conditionally.
If (m MOD 2) = 1 Then
a = ml + aNum
bNum = n \ 2
For b = nl To nl + bNum -1
h = pRange(a, b)
pRange(a, b) = pRange(a, nu+nl-b)
pRange(a, nu+nl-b) = h
Next b
EndIf
centralFlip2D = pRange
End Function
Function verticalFlip2D(pRange())
REM The function is applicable to any m x n - range where m, n are positive integers, the value 1 allowed in both places.
If NOT IsArray(pRange) Then
Dim hRange(1 To 1, 1 To 1)
hRange(1,1) = pRange
pRange = hRange
EndIf
Dim aNum As Long, bNum as Long, a As Long, b As Long
Dim ml As Long, mu As Long, nl As Long, nu As Long, m As Long, n As Long
Dim h
ml = Lbound(pRange(),1) : mu = Ubound(pRange(),1) : m = mu - ml +1
nl = Lbound(pRange(),2) : nu = Ubound(pRange(),2) : n = nu -nl + 1
aNum = m \ 2
REM The upper half and the lower half of the array are mirrored now over the horizontal middle axis excluding the middle row if one exists at all.
bNum = n
For a = ml To ml + aNum - 1 'Row index a
For b = nl To nl + bNum - 1 'Column idex b
h = pRange(a, b)
pRange(a, b) = pRange(mu+ml-a, b)
pRange(mu+ml-a, b) = h
Next b
Next a
REM In case of an odd number of rows the middle row can remain untouched.
verticalFlip2D = pRange
End Function
Function horizontalFlip2D(pRange())
REM The function is applicable to any m x n - range where m, n are positive integers, the value 1 allowed in both places.
If NOT IsArray(pRange) Then
Dim hRange(1 To 1, 1 To 1)
hRange(1,1) = pRange
pRange = hRange
EndIf
Dim aNum As Long, bNum as Long, a As Long, b As Long
Dim ml As Long, mu As Long, nl As Long, nu As Long, m As Long, n As Long
Dim h
ml = Lbound(pRange(),1) : mu = Ubound(pRange(),1) : m = mu - ml +1
nl = Lbound(pRange(),2) : nu = Ubound(pRange(),2) : n = nu -nl + 1
aNum = m
REM The left half and the right half of the array are mirrored now over the vertical middle axis excluding the middle column if one exists at all.
bNum = n \ 2
For b = nl To nl + bNum -1 'Column index
For a = ml To ml + aNum -1 'Row index
h = pRange(a, b)
pRange(a, b) = pRange(a, nu+nl-b)
pRange(a, nu+nl-b) = h
Next a
Next b
REM In case of an odd number of columns the middle column can remain untouched.
horizontalFlip2D = pRange
End Function
No attempt made to include formats!
Code: Select all
REM ***** BASIC *****
REM Module 'Standard.subForSelection'
Sub flipInSituCaller(pEvent) ' The pEvent is supposed to be raised by an OK-Button click (Release).
REM Should be assigned to the event 'Mouse button released' of an OK button.
If (pEvent.X<0) OR (pEvent.X>pEvent.Source.Size.Width) OR (pEvent.Y<0) OR (pEvent.Y>pEvent.Source.Size.Height)Then exit Sub
choice = pEvent.Source.Model.Tag ' In the property editor of the 'Button' the .Tag is named "Additional information". (Bad idea.)
Select Case choice
Case "central", "vertical", "horizontal": flipInSitu(choice)
Case Else : MsgBox("No flip action defined.")
End Select
End Sub
Sub flipInSitu(pChoice)
theRange = ThisComponent.CurrentSelection
If NOT theRange.SupportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
dA = theRange.GetDataArray ' Always 0-based!
um = Ubound(dA) : un = Ubound(dA(0))
Dim wD(0 To um, 0 To un) ' The dA is a 1D-column-array of 1D row-arrays. My centralFlip2D() cannot handle it directly.
For y = 0 To um ' Of course you may write either a specialised flipping routine for this kind of structure
For x = 0 To un ' or modify the body of 'centralFlips2D()' to alternatively handle it. (Not very efficient?)
wD(y, x) = dA(y)(x) ' Here I preferred to pay with RAM. Don't use the routine for a complete sheet of 2^30 cells.
Next x
Next y
Select Case pChoice
Case "vertical" : wD = verticalFlip2D(wD)
Case "horizontal": wD = horizontalFlip2D(wD)
Case "central" : wD = centralFlip2D(wD)
Case Else : Exit Sub
End Select
For y = 0 To um
For x = 0 To un
dA(y)(x) = wD(y, x)
Next x
Next y
theRange.SetDataArray(dA)
End Sub