I have the following multidimensional array structure
Type Wedge
C407 As Long
C417 As Long
C507 As Long
C516 As Long
C607 As Long
C617 As Long
C707 As Long
C716 As Long
C807 As Long
C817 As Long
C907 As Long
C916 As Long
End Type
The above has about 35 elements to it
Global myWedge() As Wedge
ReDim myWedge(99, 4)
I have populated the array but now want to output the contents of the array to a worksheet. Previously in other smaller arrays I have outputted each element as below.
'Output IOTT Number and Duration
For a = 1 To 4
If YGBL(x, a).IOTT > 0 Then sOutput.Cells(x + 4, IOTTCol) = YGBL(x, a).IOTT
IOTTCol = IOTTCol + 2
If YGBL(x, a).IOTTDUR > 0 Then sOutput.Cells(x + 4, IOTTDUR) = YGBL(x, a).IOTTDUR
IOTTDUR = IOTTDUR + 2
Next a
But given the number of elements I just want to loop through the elements and put this into a sheet without have to do the above for each elements.
Is this possible
Thanks
Use a function....
Function PropertyOf(wedgeType As Wedge, index As Integer) As Long
Dim w As Long
With wedgeType
Select Case index
Case 1
w = .C407
Case 2
w = .C417
Case 3
w = .C507
....
End Select
End With
PropertyOf = w
End Function
Then
Dim w As Wedge
For a = 1 To 4
w = myWedge(x, a)
For c = 1 To 35
p = PropertyOf(w, c)
If p > 0 Then
' Do your stuff here
End If
Next c
Next i
Related
I have an array that can vary in size, with n columns and m rows, and I need to find all the combinations of one element for each row/column combination, but exclude any combinations where the element is zero. So, in practice, if I have:
Row
Item1
Item2
Item3
1
A
B
C
2
D
E
F
I will have 2^3 = 8 possible combinations: ABC, ABF, AEC, AEF, DBC, DBF, DEC, DEF.
But if instead of B I have a zero in row 1 Item2, I want to exclude that cell from the list of combinations (in bold above), so I would end up with: AEC, AEF, DEC and DEF.
I found some code that give me all the possible combinations on a fixed number of columns (Macro to make all possible combinations of data in various columns in excel sheet), but it doesn't account for an array that can change dimensions, or for the exclusion rule above.
I'm just going to post the code for the simple (no zeroes) case so you can see where I'm going with this (of course I have realised that Base switches over to letters for radix 11 onwards so this might not be the smartest approach :) )
Function ListCombos(r As Range)
Dim s As String, result As String
Dim arr()
Dim j As Integer, offset As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, i As Long
rows = r.rows.Count
cols = r.Columns.Count
nComb = rows ^ cols
ReDim arr(1 To nComb)
For i = 1 To nComb
s = Application.Base(i - 1, rows, cols)
result = ""
For j = 1 To cols
offset = CInt(Mid(s, j, 1))
result = result & r.Cells(1, 1).offset(offset, j - 1)
Next j
arr(i) = result
Next i
ListCombos = arr
End Function
This is the version skipping combinations which contain zeroes. The method is to move non-zero values to the first rows of a holding array so effectively if you start with something like this
You make it look like this
So you don't have to generate or check all the combinations that contain zeroes.
Then use mixed radix to cycle through the combinations:
Option Explicit
Option Base 1
Function ListCombosWithZeroes(r As Range)
Dim s As String, result As String
Dim arr()
Dim i As Integer, j As Integer, offset As Integer, count As Integer, carry As Integer, temp As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, iComb As Long
Dim holdingArr(20, 20) As String
Dim countArr(20) As Integer
Dim countUpArr(20) As Integer
rows = r.rows.count
cols = r.Columns.count
' Move non-zero cells to first rows of holding array and establish counts per column
For j = 1 To cols
count = 0
For i = 1 To rows
If r.Cells(i, j) <> 0 Then
count = count + 1
holdingArr(count, j) = r.Cells(i, j)
End If
Next i
countArr(j) = count
Next j
' Calculate number of combos
nComb = 1
For j = 1 To cols
nComb = nComb * countArr(j)
Next j
ReDim arr(1 To nComb)
'Loop through combos
For iComb = 1 To nComb
result = ""
For j = 1 To cols
offset = countUpArr(j)
result = result & holdingArr(offset + 1, j)
Next j
arr(iComb) = result
'Increment countup Array - this is the hard part.
j = cols
'Set carry=1 to force increment on right-hand column
carry = 1
Do
temp = countUpArr(j) + carry
countUpArr(j) = temp Mod countArr(j)
carry = temp \ countArr(j)
j = j - 1
Loop While carry > 0 And j > 0
Next iComb
ListCombosWithZeroes = arr
End Function
You don't have to have equal numbers of letters per column.
Here's a solution. Probably not most efficient, since it is O(n2), but it works.
Caveats
I put a '.' instead of zero to avoid dealing with numeric vs alphanumeric values, but you can easily change this
Since I build the strings incrementally I need indices to be predictable. Hence I fill all the possible combinations and then remove the ones containing a '.' in a second pass
Global aws As Worksheet
Global ur As Range
Global ccount, rcount, size, rptline, rptblock, iblk, iln, idx As Integer
Global tempcombos(), combos() As String
Public Sub Calc_combos()
Set aws = Application.ActiveSheet
Set ur = aws.UsedRange
ccount = ur.Columns.Count
rcount = ur.Rows.Count
size = (rcount - 1) ^ (ccount - 1)
ReDim tempcombos(size - 1)
ReDim combos(size - 1)
rptline = size / (rcount - 1)
rptblock = 1
For c = 2 To ccount
idx = 0
For iblk = 1 To rptblock
For r = 2 To rcount
For iln = 1 To rptline
tempcombos(idx) = tempcombos(idx) & Cells(r, c)
idx = idx + 1
Next iln
Next r
Next iblk
rptline = rptline / (rcount - 1)
rptblock = rptblock * (rcount - 1)
Next c
idx = 0
For iln = 0 To size - 1
If InStr(tempcombos(iln), ".") = 0 Then
combos(idx) = tempcombos(iln)
idx = idx + 1
End If
Next iln
End Sub
The Python way:
from dataclasses import dataclass, field
from itertools import product
from random import randint
from typing import Dict, List
#dataclass
class PriceComparison():
rows : int
cols : int
maxprice : int = 50
threshold : int = 0
itemcodes : List[List[str]] = field(init=False)
pricelist : Dict[str, int] = field(init=False)
def __post_init__(self):
##create sample data
self.itemcodes = [[f'A{r+self.cols*c:03d}' for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print(f'removing {item} from {col}')
col.remove(item)
del self.pricelist[item]
def find_cheapest(self):
iterations = 1
for col in self.itemcodes:
iterations *= len(col)
print(f'this may require {iterations} iterations!')
cheapest = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes)):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < cheapest:
print(f'current cheapest is {price} at iteration {i}')
cheapest = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
Some notes:
I assume the cheapest combo is not simply given by selecting the cheapest item in each column, otherwise we would not need all this complicated machinery; so I inserted a random coefficient while calculating the total price of a combo - this should be replaced with the actual formula
I also assume we have item codes in our input table, with prices for each item stored elsewhere. As sample data I create codes from 'A000' to 'Axxx', and assign a random price between 0 and a maxprice to each one
Items with price = 0 are removed immediately, before the search for the cheapest combo
For large input tables the search will take a very long time. So although it wasn't requested I also added an optional threshold parameter: if we find a total price under that value we consider it is cheap enough and stop the search
EDIT
The following is a Python 3.5 compatible version.
However it must be noted that with a 10x15 input table the number of required iterations will be somewhere near 1E+15 (something less actually, depending on how many cells we are able to ignore as "obvious outliers"). Even if we check 1 million combos per second it will still run for (something less than) 1E+09 seconds, or about 32 years.
So we need a way to improve our strategy. I integrated two options:
Setting a threshold, so that we don't search for the actual best price but stop as soon as we find an "acceptable" one
Splitting the tables in "zones" (subsets of columns), looking for the best partial solution for each zone and then combining them.
Sample runs:
##10 x 15, 5 zones, each 3 columns wide
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 71 in 0.06 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 2 at iteration 291 in 0.11 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 330 in 0.07 secs
this may require up to 8.100000e+02 iterations!
...
current best price is 4 at iteration 34 in 0.09 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 82 in 0.07 secs
['A000', 'A106', 'A017', 'A033', 'A139', 'A020', 'A051', 'A052', 'A008', 'A009', 'A055', 'A131', 'A147', 'A133', 'A044']
##10 x 15, no zones, threshold = 25
this may require up to 8.100000e+14 iterations!
...
current best price is 24 at iteration 267493282 in 1033.24 secs
under threshold: returning
['A000', 'A001', 'A002', 'A003', 'A004', 'A005', 'A051', 'A052', 'A008', 'A039', 'A055', 'A071', 'A042', 'A133', 'A044']
Code follows:
from itertools import product
from random import randint
from time import time
class PriceComparison():
def __init__(self, rows, cols, zones = [], maxprice = 50, threshold = 0):
self.rows = rows
self.cols = cols
if zones == []:
self.zones = [cols]
else:
self.zones = zones
self.maxprice = maxprice
self.threshold = threshold
self.__post_init__()
def __post_init__(self):
##create sample data
self.itemcodes = [['A%03d' % (r+self.cols*c) for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print('removing %s from %s' % (item, col))
col.remove(item)
del self.pricelist[item]
def find_cheapest(self, lo, hi):
iterations = 1
for col in self.itemcodes[lo:hi]:
iterations *= len(col)
start = time()
print('\nthis may require up to %e iterations!' % (iterations))
bestprice = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes[lo:hi])):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < bestprice:
elapsed = time() - start
print('current best price is %d at iteration %d in %.2f secs' % (price, i, elapsed))
cheapest = combo
bestprice = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
def find_by_zones(self):
print(self.zones)
fullcombo = []
lo = 0
for zone in self.zones:
hi = lo + zone
fullcombo += self.find_cheapest(lo, hi)
lo = hi
return fullcombo
I have a REGEX loop that finds certain strings (the Match.value in the code below). I need to preform this loop 4 times, with 4 different REGEX's, and cumulatively build the array as it finds matches in each of the four REGEX loops.
I've been able to populate a 1D array with my matches but I cannot figure out how to add other information (all static text/strings that are associated with each match) to the other dimensions. I looking to end up with something like this:
Match.value | String1_here | String2_here | String3_here | String4_here
Dim serialArray() As String
For Each Match in theMatches
Redim Preserve serialArray(x)
serialArray(x) = Match.value
x = x + 1
Next Match
Try the following...
With theMatches
If .Count > 0 Then
ReDim serialArray(1 To .Count, 1 To 5) 'allocate storage space for an N X 5 array
x = 1
For Each Match In theMatches
serialArray(x, 1) = Match.Value
serialArray(x, 2) = "String1"
serialArray(x, 3) = "String2"
serialArray(x, 4) = "String3"
serialArray(x, 5) = "String4"
x = x + 1
Next Match
End If
End With
I have a function in VBA for Excel that returns a 2 dimensional array.
In addition I have another function that takes two members of that array and adds them together.
Lastly, I have a third function that loops on the second function's result until a certain value is reached.
The first two functions work fine. I can index the array in a worksheet and I can make a get good results in a cell for the second function.
The third function also works but only if I comment out the looping portion. When I enable the do loop in the third function I receive "A value used in the formula is the wrong data type" error in the cell.
I tried solving the problem by making everything a double (as shown in the code).
I've also commented out the Do While and Loop lines and verified that the code runs as long as it's not looping.
This is function 1:
Function makeArray1(aaa As Double, bbb As Double, ccc As Double) As Double()
Dim workArray() As Double
ReDim workArray(1 To 4, 1 To 3)
workArray(1, 1) = aaa
workArray(1, 2) = bbb
workArray(1, 3) = ccc
workArray(2, 1) = aaa + 1
workArray(2, 2) = bbb + 1
workArray(2, 3) = ccc + 1
workArray(3, 1) = aaa + bbb
workArray(3, 2) = bbb + ccc
workArray(3, 3) = ccc + aaa
workArray(4, 1) = 1
workArray(4, 2) = 2
workArray(4, 3) = 3
makeArray1 = workArray()
End Function
This is function 2:
Function findValue1(aaa As Double, bbb As Double, ccc As Double) As Double
Dim Value As Double
Dim result() As Double
result = makeArray1(aaa, bbb, ccc)
Value = result(1, 3) + result(4, 3)
findValue1 = Value
End Function
This is function 3:
Function valueLoop(aaa As Double, bbb As Double) As Double
Dim seed As Double
Dim importantValue As Double
seed = 1#
Do While seed < 100#
importantValue = findValue1(aaa, bbb, seed)
seed = seed + 1#
Loop
valueLoop = importantValue
End Function
I am expecting the loop to run until seed = 100. Then the result of the valueLoop or importantValue should be 102.
The error message I get is a #VALUE! in the cell with the description: "A value used in the formula is the wrong data type".
Say we are given a vector which sums to 1. Assume if values are higher than n, we maximize these to value n, and we want to make the rest of the numbers such that the sum equals 1 again. I.e. the other values need to (potentially) increase.
The other values must increase evenly (by the same factor)
Is there an easy way in excel to do this?
Ex. let n = 0.25
0.077331613 0.077331613
0.237037801 0.237037801
0.341441747 0.25
0.336289699 0.25
0.007899139 0.007899139
The second vector does not sum to 1, and we need to make sure it does without changing elements of value 0.25.
Not sure I agree that the required formulas are "long" and "complicated", nor "calculation intensive" :-).
Assuming your original values are in A2:A6, and your choice of n, e.g. 0.25, in C1, then, in B2:
=IF(A2>=C$1,C$1,A2*(1-C$1*COUNTIF(A$2:A$6,">="&C$1))/SUMIF(A$2:A$6,"<"&C$1))
Copy down to B6.
Regards
I was working on this UDF while the other answer was accepted so I'll post it here for future viewers of this thread.
Tap Alt+F11 then Alt+I, M and paste the following into a module code sheet. Tap Alt+Q to return to your worksheet.
Function udf_vector_elements(rng As Range, elm As Long, n As Double, ttl As Double)
Dim dTTL As Double
Dim v As Long, vELMs As Variant
Dim awf As WorksheetFunction
Dim iSAFETY As Long, iLESS As Long, dFUDGE As Double
Set awf = Application.WorksheetFunction
ReDim vELMs(1 To rng.Cells.Count)
'safety for not enough elements × n < ttl
If rng.Cells.Count * n < ttl Then
udf_vector_elements = "never enough"
Exit Function
End If
'seed the solution array
For v = LBound(vELMs) To UBound(vELMs)
If rng.Cells(v).Value2 < n Then
vELMs(v) = rng.Cells(v).Value2
iLESS = iLESS + 1
Else
vELMs(v) = n
End If
Next v
'safety for sum(elements) > ttl
If awf.Sum(vELMs) > ttl Then
udf_vector_elements = "already too much"
Exit Function
End If
'get to work
Do While Round(awf.Sum(vELMs), 6) < ttl
dFUDGE = (ttl - Round(awf.Sum(vELMs), 6)) / iLESS
iLESS = 0
For v = LBound(vELMs) To UBound(vELMs)
vELMs(v) = Round(awf.Min(vELMs(v) + dFUDGE, n), 6)
iLESS = iLESS - (vELMs(v) <> n)
Next v
Loop
'debug.print
dTTL = awf.Sum(vELMs)
Set awf = Nothing
'return the individual adjusted vector array element
udf_vector_elements = vELMs(elm)
End Function
Use as any other native worksheet function.
=udf_vector_elements(<vector_values>, <element_returned>, <max_n>, <target_total>)
In the below image in C2 as,
=udf_vector_elements(A$2:A$6, ROW(1:1), E$1, 1)
Fill down as necessary.
I need a way to compare two arrays in vb.net and save result in third array:
Dim KonRes(3) As Integer
Dim UserRes(3) As Integer
Dim YelRed(3) As Integer
KonRes(0) = 1
KonRes(1) = 2
KonRes(2) = 3
KonRes(3) = 4
UserRes(0) = 4
UserRes(1) = 3
UserRes(2) = 2
UserRes(3) = 1
How to compare those arrays so in declared variable YelRed I should have results like this:
If UserRes(0) = KonRes(0) Then
YelRed(0) = 2
If UserRes(0) = KonRes(1 or 2 or 3) Then
YelRed(0) = 1
If UserRes(0) does not contain any number like in KonRes then YelRed(0) should be 0. Also it should not make duplicate results, in other words if it already checked UserRes(0) = KonRes(0) then it should not check KonRes(0) in next check. It's not a problem to compare if those arrays are completely same, my problem is comparing each value of one array with other one, and collect results. Any suggestions?
There are a few basic ways of checking for a value in an integer array. The first is to manually search by looping through each value in the array, which may be what you want if you need to do complicated comparisons.
Second is the .Contains() method. It is simpler to use but will only give you a Boolean indicating whether the value is in the array or not. Example:
If KonRes.Contains(UserRes(0)) Then YelRed(0) = 1
Lastly, there's the IndexOf() function. It searches for a match and returns the index of a match if found, or one below the lower bound of the array if not (-1 for typical 0-based arrays). As I understand your needs from your comments above, this code should do the trick:
For i As Integer = 0 To 3
Select Case IndexOf(KonRes, UserRes(i))
Case i 'Matching postion
YelRed(i) = 2
Case -1 'No match found
YelRed(i) = 0
Case Else 'Match found at another position
YelRed(i) = 1
End Select
Next i
EDIT: I misunderstood the qualification about duplicates until #Sastreen clarified it. Here's a rewrite tailored to not count the same index as a match twice:
Dim processed(3) As Boolean
For i As Integer = 0 To 3
YelRed(i) = 0
If KonRes(i) = UserRes(i) And Not processed(i) Then
processed(i) = True
YelRed(i) = 2
Else
For j As Integer = 0 To 3
If KonRes(j) = UserRes(i) Then
processed(j) = True
YelRed(i) = 1
Exit For
End If
Next j
End If
Next i
If UserRes(0) = KonRes(0) that mean they are in same position in two
arrays, then YelRed(0) = 2, if UserRes(0) = KonRes(1,2,3) so number is
there and but not in same position, so YelRed(0) =1 and if the number
is not in second array it must be 0.
Use a For-Loop:
For i As Int32 = 0 To KonRes.Length - 1
If KonRes(i) = UserRes(i) Then
' Same position '
YelRed(i) = 2
ElseIf UserRes.Contains(KonRes(i)) Then
' Other position '
YelRed(i) = 1
Else
' Not contained '
YelRed(i) = 0
End If
Next
You can use nested For loops to go through the two arrays to compare, and then use Exit For to leave at any time.
The indicesToIgnore is for making sure it does not "make duplicate results" (this is harder to achieve with the IndexOf and contains methods).
Also it should not make duplicate results, in other words if it already checked UserRes(0) = KonRes(0) then it should not check KonRes(0) in next check.
Dim indicesToIgnore as New List(Of Integer)
'go through first array
For i as Integer = 0 to UserRes.length - 1 Step 1
'go through second array
For j as Integer = 0 to KonRes.length- 1 Step 1
'if the values are equal, check whether same index, then exit for
If (Not indicesToIgnore.contains(j) AndAlso UserRes(i) = KonRes(j)) Then
If i=j Then
YelRed(i) = 2
indicesToIgnore.add(j)
Else
YelRed(i) = 1
End If
Exit For
End If
Next
Next
You don't need to set YelRed(i) to 0 at any time because it defaults as this. You just need to make sure YelRed has the same size as the other arrays.
If you also want it to not look at the KonRes value (for duplicates) if it contains it at a different index, simply add indicesToIgnore.add(j) at the end of the Else (after YelRed(i) = 1) as well.
I think this will do the job, if KonRes(0) = UserRes(0) then YelRed(0) = 1 else YelRed(0) = 2
Dim KonRes(3) As Integer
Dim UserRes(3) As Integer
Dim YelRed(3) As Integer
KonRes(0) = 1
KonRes(1) = 2
KonRes(2) = 3
KonRes(3) = 4
UserRes(0) = 4
UserRes(1) = 2
UserRes(2) = 2
UserRes(3) = 1
Dim Uindex As Integer = 0
For Each item In UserRes
Dim Kindex As Integer = 0
For Each i In KonRes
If item = i Then
If Kindex = Uindex Then
YelRed(Uindex) = 1
Else
YelRed(Uindex) = 2
End If
End If
Kindex += 1
Next
Uindex += 1
Next
You didn't told us what the output should be. It's a bit confusing. In my case, it will be {1, 1, 0, 0}. If was to be done with 2 for loop. On that loops everything in KonRes while the other only loop what wasn't checked yet in UserRes.
For k As Integer = 0 To KonRes.Length - 1
If KonRes(k) = UserRes(k) Then
YelRed(k) = 2
Else
YelRed(k) = 0
For u As Integer = k + 1 To UserRes.Length - 1
If KonRes(k) = UserRes(u) Then
YelRed(k) = 1
Exit For
End If
Next
End If
Next
You could use the comparison from the array.
Dim iNextActivityTypeCd As Integer = 18400
Dim activities() As Integer = {1,18400, 2300, 3423}
If activities.Contains(iNextActivityTypeCd) Then
Dim foo = 1
End If