Reputation: 167
Learning VBA for Excel, I am trying to do as much of my coding without the use of loops. As an exercise, multiplying the numbers of two adjacent ranges, I came up with this:
Sub multiply_range()
Dim a, b, c As Range
Set a = Range("a1:a5")
Set b = Range("b1:b5")
Set c = Range("c1:c5")
a.Value = Evaluate("row(" & a.Address & ")")
b.Value = Evaluate("row(" & b.Address & ")")
c.Value = Evaluate(a.Address & "*" & b.Address)
End Sub
Which works quite nicely. Now I want to do something similar but using arrays instead. Starting with this code:
Sub multiply_array()
Dim aArr(), bArr(), cArr()
ReDim aArr(5), bArr(5), cArr(5)
For i = 0 To 4
aArr(i) = i + 1
bArr(i) = i + 1
Next
For i = 0 To 4
cArr(i) = aArr(i) * bArr(i)
Next
For i = 0 To 4
Range("D" & i + 1).Value = cArr(i)
Next
End Sub
How would you replace any one of these FOR loops with code that doesn't use loops?
Upvotes: 4
Views: 5157
Reputation: 5567
For multiplying arbitrary arrays you can try pasting this code in a new module:
Dim X, Y
Sub MultiplyArrays()
Dim Z
X = Array(1, 2, 3, 4, 5)
Y = Array(1, 2, 3, 4, 5)
Z = [GetX()*GetY()]
Range("D1").Resize(UBound(Z)) = Application.Transpose(Z)
End Sub
Function GetX()
GetX = X
End Function
Function GetY()
GetY = Y
End Function
Another slightly trickier way is to use worksheetfunction methods:
Sub MultiplyArrays2()
Dim X, Y, Z
X = Array(1, 2, 3, 4, 5)
Y = Array(1, 2, 3, 4, 5)
With Application
Z = .PV(, 1, .PV(, X, Y))
Range("D1").Resize(UBound(Z)) = .Transpose(Z)
End With
End Sub
Also see: Adding or multiplying variants in VBA
Upvotes: 3
Reputation: 52008
You can create a couple of helper-functions inspired by functional programming. You can store these in a module (together with other functions for manipulating arrays) and import them as needed.
Function Map(f As String, A As Variant) As Variant
'assumes that A is a 1-dimensional variant array
'and f is the name of a function that can be applied to it
Dim i As Long
Dim M As Variant
ReDim M(LBound(A) To UBound(A))
For i = LBound(A) To UBound(A)
M(i) = Application.Run(f, A(i))
Next i
Map = M
End Function
Function ZipWith(f As String, A As Variant, B As Variant)
'assumes that A,B are 1-dimensional variant arrays with the same bounds
'and f is the name of a function with two variables
Dim i As Long
Dim M As Variant
ReDim M(LBound(A) To UBound(A))
For i = LBound(A) To UBound(A)
Select Case f:
Case "+":
M(i) = A(i) + B(i)
Case "-":
M(i) = A(i) - B(i)
Case "*":
M(i) = A(i) * B(i)
Case "/":
M(i) = A(i) / B(i)
Case "&":
M(i) = A(i) & B(i)
Case "^":
M(i) = A(i) ^ B(i)
Case Else:
M(i) = Application.Run(f, A(i), B(i))
End Select
Next i
ZipWith = M
End Function
Tested like thus:
Function square(x As Variant) As Variant
square = x * x
End Function
Sub test()
Dim A As Variant, B As Variant, squares As Variant, products As Variant
A = Array(2, 3, 4)
B = Array(5, 6, 7)
squares = Map("square", A)
products = ZipWith("*", A, B)
Debug.Print Join(squares, " ")
Debug.Print Join(products, " ")
End Sub
Note the absence of loops in the test sub. Output is as expected:
4 9 16
10 18 28
Upvotes: 1
Reputation: 14764
Here you go:
Sub Squares()
Dim n&
n = 5
[d1].Resize(n) = Evaluate("row(1:" & n & ")^2")
End Sub
UPDATE
Here is a variant that uses no loops and no ranges:
Sub Squares()
Dim a, b, n&
n = 5
a = Array(1, 2, 3, 4, 5)
b = Array(1, 2, 3, 4, 5)
[d1].Resize(n) = Evaluate("{" & Join(a, ";") & "}*{" & Join(b, ";") & "}")
End Sub
Upvotes: 7