i have got the following problem. I am creating an excel worksheet with active x elements to calculate several values (for a class in university). And in the following code i sometimes (not everytime) get the runtime error 9 that the index is out of range (hopefully i translated it correctly into english). I am new to vba. I know that there are several similar problems already asked but i have a huge problem to adapt the solutions to my code as i don't really understand either the problem in my code as also the solutions of their problems.
I marked the line for which the error occurs with stars.
I would be really thankful if anybody could explain, why this problem occurs in my code sometimes and how to solve it properly.
Thank you in advance.
Here's the code:
Sub calcinull()
Dim ione(4), itwo(4), ii, ints(4), cs(4), io, it As Double
Dim a, b, c As Double
ione(0) = 0
ione(1) = 10
ione(2) = 20
ione(3) = 30
ione(4) = 40
itwo(0) = 100
itwo(1) = 90
itwo(2) = 80
itwo(3) = 70
itwo(4) = 60
For b = 0 To 4
ii = ione(b) + (((itwo(b) - ione(b)) * (NPV(ione(b))) / (NPV(ione(b)) - NPV(itwo(b)))))
ints(b) = ii
cs(b) = NPV(ii)
Next b
Dim AbsInt(4), AbsCs(4) As Double
For a = 0 To 4
AbsInt(a) = VBA.Abs(ints(a))
AbsCs(a) = VBA.Abs(cs(a))
Next a
Dim pos As Integer
pos = Application.Match(Application.Min(AbsCs), AbsCs, 0)
*ii = ints(pos)*
If NPV(ii) > 0 Then
io = ii
If pos > 0 Then
it = itwo(pos - 1)
Else
it = itwo(0)
End If
ElseIf NPV(ii) < 0 Then
it = ii
If pos > 0 Then
io = ione(pos - 1)
Else
io = ione(0)
End If
ElseIf NPV(ii) = 0 Then
inull = ii
End If
For c = 1 To 30
Do Until (NPV(io) - NPV(it)) <> 0
io = io - 0.1
it = it + 0.1
Loop
ii = io + (((it - io) * (NPV(io)) / (NPV(io) - NPV(it))))
If NPV(ii) > 0 Then
io = ii
If it > (io + 0.5) Then
it = it - 0.5
End If
ElseIf NPV(ii) < 0 Then
it = ii
If io < (it - 0.5) Then
io = io + 0.5
End If
ElseIf NPV(ii) = 0 Then
inull = ii
Exit For
End If
Next c
inull = ii
End Sub
As ints is an array with 5 elements (0..4), probably pos is > 4 when this error occurs.
If you can't tell why, maybe put something like this behind the Match-Statement and set a breakpoint to the print while testing.
if pos < 0 or pos > 4 then
debug.print pos & " is off"
end if
Alright guys, i solved it. The problem was, that the arrays uses indices from 0 to x, whereas the position gives the nth position of the array, which means, that my "pos"-variable is always one integer above the array-index.
Thank you all for your help!
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
This is what I am trying to do, created a random array to demonstrate:
% all IDs
all_IDS = 1:216000000;
% Array 1
X = round(1550*rand(216000000,1));
Y = round(1550*rand(216000000,1));
Z = round(90*rand(216000000,1));
% Array 2
Xsub = round(1550*rand(160000,1));
Ysub = round(1550*rand(160000,1));
Zsub = round(90*rand(160000,1));
del_val =1;
% required o/p
reqd_op = zeros(1,10);
% boolean indexing
indx =1;
for jj = 1:160000
VID_X = Xsub(jj);
VID_Y = Ysub(jj);
VID_Z = Zsub(jj);
I2 = (X>VID_X-del_val & X<VID_X+del_val)& (Y>VID_Y-del_val & Y<VID_Y+del_val) & (Z>VID_Z-del_val & Z<VID_Z+del_val);
len = numel(all_IDS(I2));
reqd_op(1,indx:indx+len-1) = all_IDS(I2);
indx=indx+len;
end
The above code takes a lot of time as I am dealing with a very large array , Is there a way to eliminate the for loop, meaning, instead of doing Boolean indexing element by element - can I do it for the whole array at once ?
This will run x2.5 faster, anyway, array is too big so it still takes 0.3s per loop, so 160000 loops is like 13 hours on single cpu.
if ~exist('X','var')
% Array 1
X = round(1550*rand(216000000,1,'single'));
Y = round(1550*rand(216000000,1,'single'));
Z = round(90*rand(216000000,1,'single'));
% Array 2
Xsub = round(1550*rand(160000,1,'single'));
Ysub = round(1550*rand(160000,1,'single'));
Zsub = round(90*rand(160000,1,'single'));
end
del_val =single(1);
reqd_op = zeros(1,10,'single');% required o/p
tic
index =1;
for jj = 1:10
VID_X = Xsub(jj);
VID_Y = Ysub(jj);
VID_Z = Zsub(jj);
IdxFinal=[];
Idx1=find(abs(X-VID_X)<del_val); %little better than X>VID_X-del_val & X<VID_X+del_val)
if ~isempty(Idx1)
Idx2 = Idx1(Y(Idx1)>VID_Y-del_val & Y(Idx1)<VID_Y+del_val);
if ~isempty(Idx2)
Idx3= Idx2(Z(Idx2)>VID_Z-del_val & Z(Idx2)<VID_Z+del_val);
IdxFinal=Idx3;
end
end
len = length(IdxFinal);
index=index+len;
if len>0
reqd_op(1,index:index+len-1) = IdxFinal;
end
end
toc
I wrote a 1D array sorting code, however the first value disappears after sorting. Here is my code:
For i = 0 To 10 - 1
For j = 0 To (10 - 1) - i
If Xs(j) > Xs(j + 1) Then
tmp = Xs(j)
Xs(j) = Xs(j + 1)
Xs(j + 1) = tmp
End If
Next j
Next i
Original array:
0.995136318967065
1.92659411953677E-02
0.075211466386023
0.276865639306513
0.796949177428061
0.644136557566409
0.912439108707731
0.318021611061513
0.863316048056547
0.469710111256482
Array after sorting:
0
1.92659411953677E-02
0.075211466386023
0.276865639306513
0.318021611061513
0.469710111256482
0.644136557566409
0.796949177428061
0.863316048056547
0.912439108707731
I suspect you have dimensioned your array 0 To 10:
Dim Xs(0 To 10)
so creating 11 spaces into it. However, you have only 10 of them so you will have an Empty cell that will put itself on the first position at some point of the loop (being it evaluated as 0, which is indeed the lowest value into your dataset).
I also believe you have dimensioned your array 0 To 10 instead of 0 To 9 because, if not, you would have got an Subscript out of range error in this part of the code:
For j = 0 To (10 - 1) - i
In order to make your code work:
a) Change the Dim Xs(0 To 10) to Dim Xs(0 To 9)
b) Change the For j = 0 To (10 - 1) - i to For j = 0 To (10 - 1) - i-1
I just switched from VBA (Excel) to VB (Visual Studio Express 2013).
Now I have copied parts of my code from VBA to VB.
And now I'm wondering why VB is so slow...
I'm creating an Array (IFS_BV_Assy) with 4 column and about 4000 rows.
There are some identical entrys in it, so I compare every entry with each other and override the duplicate with a empty string.
The Code looks like that:
For i = 1 To counter
For y = 1 To counter
If IFS_BV_Assy(1, y) = IFS_BV_Assy(1, i) And i <> y Then
If IFS_BV_Assy(2, i) < IFS_BV_Assy(2, y) Then
IFS_BV_Assy(1, i) = ""
Else
IFS_BV_Assy(1, y) = ""
End If
Exit For
End If
Next
Next
Counter is the lenght of the Array.
In VBA it takes about 1 Sec. In VB it takes about 30 Sec. to go thru the loop. Somebody knows why? (im creating some Timestamp between every Step to be sure whats slow. And that loop is the bad guy)
The Array looks like this:
(1,1) = 12.3.015 / (2,1) = 02
(1,2) = 12.3.016 / (2,2) = 01 <-- delete
(1,3) = 12.3.016 / (2,3) = 02 <-- keep, because 02 is newer then 01
(1,4) = 12.3.017 / (2,4) = 01
(1,5) = 12.3.018 / (2,5) = 01
Thanks in advance
Andy
Edit: I create the Array like that:
strStartPath_BV_Assy = "\\xxx\xx\xx\"
myFile = Dir(strStartPath_BV_Assy & "*.*")
counter = 1
ReDim IFS_BV_Assy(0 To 2, 0 To 0)
IFS_BV_Assy(0, 0) = "Pfad"
IFS_BV_Assy(1, 0) = "Zg."
IFS_BV_Assy(2, 0) = "Rev"
Do While myFile <> ""
If UCase(Right(myFile, 3)) = "DWG" Or UCase(Right(myFile, 3)) = "PDF" Then
ReDim Preserve IFS_BV_Assy(0 To 2, 0 To counter)
IFS_BV_Assy(0, counter) = strStartPath_BV_Assy + myFile
IFS_BV_Assy(1, counter) = Left(Mid(myFile, 12), InStr(1, Mid(myFile, 12), "-") - 1)
IFS_BV_Assy(2, counter) = Mid(myFile, Len(myFile) - 8, 2)
counter = counter + 1
End If
myFile = Dir()
Loop
Maybe data was best case (around 4000) when ran in VBA.
30 sec seems a reasonable time for 4000x4000=16.000.000 iterations. 1 sec is too low for this number of iterations.
Stokke suggested to create the array as String instead of Objekt Type.
Dim IFS_BV_Assy(,) as String
I create the Module with Option Explicit Off, because I never see any difference in VBA for that point. Now I declare any variable with Dim .. as ....
And now, it's as fast as VBA is =)
Learning = making mistakes.. =)
I have a large data set in an array <1x43 cell>. The data size is really large, these are some of the cell dimensions - 5 are <1x327680 double>, 11 are <1x1376256 double>
I am attempting to carry out a resample operation which I have a function for. (Function code shown below). I am trying to take an entire cell from the array, perform the Resample operation and store the result back in the same array location or a different one.
However, I get the following error in line 19 or the Resample function -
"Error using zeros
Maximum variable size allowed by the program is exceeded.
Error in Resample (line 19)
obj = zeros(t,1);
I run into an out of memory error when I comment our that line 19.
Please is there a more efficient way to manipulate such large data sets?
Thank you.
Actual Code:
%% To load each ".dat" file for the 51 attributes to an array.
a = dir('*.dat');
for i = 1:length(a)
eval(['load ' a(i).name ' -ascii']);
end
attributes = length(a);
% Scan folder for number of ".dat" files
datfiles = dir('*.dat');
% Count Number of ".dat" files
numfiles = length(datfiles);
% Read files in to MATLAB
for i = 1:1:numfiles
A{i} = csvread(datfiles(i).name);
end
% Remove discarded variables
ind = [1 22 23 24 25 26 27 32]; % Variables to be removed.
A(ind) = [];
% Reshape all the data into columns - (n x 1)
for i = 1:1:length(A)
temp = A{1,i};
[x,y] = size(temp);
if x == 1 && y ~= 1
temp = temp';
A{1,i} = temp;
end
end
% Retrieves the frequency data for the attributes from Excel spreadsheet
frequency = xlsread('C:\Users\aajwgc\Documents\MATLAB\Research Work\Data\testBig\frequency');
% Removing recorded frequency for discarded variables
frequency(ind) = [];
% Upsampling all the attributes to desired frequency
prompt = {'Frequency (Hz):'};
dlg_title = 'Enter desired output frequency for all attributes';
num_lines = 1;
def = {'50'};
answer= inputdlg(prompt,dlg_title,num_lines,def);
OutFreq = str2num(answer{1});
m = 1;
n = length(frequency);
A_resampled = cell(m,n);
A_resampled(:) = {''};
for i = length(frequency);
raw = cell2mat(A(1,i));
temp= Resample(raw, frequency(i,:), OutFreq);
A_resampled{i} = temp(i);
end
Resample Function:
function obj = Resample(InputData, InFreq, OutFreq, varargin)
%% Preliminary setup
% Allow for selective down-sizing by specifying type
type = 'mean'; %default to the mean/average
if size(varargin,2) > 0
type = varargin{1};
end
% Determine the necessary resampling factor
factor = OutFreq / InFreq;
%% No refactoring required
if (factor == 1)
obj = InputData;
%% Up-Sampling required
elseif (factor > 1)
t = factor * numel(InputData(1:end));
**obj = zeros(t,1); ----------------> Line 19 where I get the error message.**
for i = 1:factor:t
y = ((i-1) / factor) + 1;
z = InputData(y);
obj(i:i+factor) = z;
end
%% Down-Sampling required
elseif (factor < 1)
t = numel(InputData(1:end));
t = floor(t * factor);
obj = zeros(t,1);
factor = int32(1/factor);
if strcmp(type,'mean') %default is mean (process first)
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = mean(InputData(y:y+factor-1));
end
elseif strcmp(type,'min')
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = min(InputData(y:y+factor-1));
end
elseif strcmp(type,'max')
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = max(InputData(y:y+factor-1));
end
elseif strcmp(type,'mode')
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = mode(InputData(y:y+factor-1));
end
elseif strcmp(type,'sum')
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = sum(InputData(y:y+factor-1));
end
elseif strcmp(type,'single')
for i = 1:t
y = (factor * (i-1)) + 1;
obj(i) = InputData(y);
end
else
obj = NaN;
end
else
obj = NaN;
end
If you have the DSP System Toolbox, you could use, e.g., the dsp.FIRInterpolator System Object (http://www.mathworks.co.uk/help/dsp/ref/dsp.firinterpolatorclass.html ) and call its step() function repeatedly to avoid processing all the data in one go.
By the way, up/downsampling (interpolation and decimation) are more complex concepts than you have assumed; in the most general sense they both require some form of filtering to remove artifacts that such processes generate.
You could design these filters yourself and convolve your signal with them, but doing this filter design requires a solid foundation in signal processing. If you want to go this route, I suggest picking up a textbook from somewhere as easy to get wrong without a reference text.