I've a legacy code base where I've four ArraysLists (different sizes). I want to compare these four arraylists and save the same values in a separate Array/Arraylist.
The arrays can have same values multiple times since ordering is not important. You can say that I just need the intersection of the ArrayLists.
The following code works, but of-course this is not the best way to do, looping on all the arrays-
For i = 0 To arr.Count - 1 Step 1
For j = 0 To arr1.Count - 1 Step 1
If arr.Item(i) = arr1.Item(j) Then
For k = 0 To arr2.Count - 1 Step 1
If arr.Item(i) = arr2.Item(k) Then
For l = 0 To arr3.Count - 1 Step 1
If arr.Item(i) = arr3.Item(l) Then
// the value arr.Item(i) exists in all 4 arrys
// save this to another array
End If
Next
End If
Next
End If
Next
Next
Since my arrayList size could be in thousands, that's not the way I want to know how should I sort out this.
Thanks.
PS. Sorry if this is a duplicate question, since I was not able search this anywhere (I'm new to VB).
you could use ArrayList.Contains to shorten / simplify things:
For i As Integer = 0 To arr.Count - 1
If Arr1.Contains(arr(i)) AndAlso Arr2.Contains(arr(i)) _
AndAlso Arr3.Contains(arr(i)) AndAlso Arr4.Contains(arr(i)) Then
// the value arr(i) exists in all 4 arrayLISTS
// save this to another array
End If
Next
Probably wont be a lot different in speed, but the code is sure easier to read. NB: AndAlso is important in this because it short circuits the later tests when it the result is false.
Related
I am trying to make a simple simulation in Excel VBA in which we roll two dices. What is the probability of getting "1"+"2" or "1"+"3"?
This is my code:
Sub ProbabilityMeyerArray()
Dim i As Long
Dim ArrayDices(1 To 100000, 1 To 2) As Variant
Dim ArrayResult(1 To 100000) As Variant
'Simulation
For i = 1 To 100000
ArrayDices(i, 1) = WorksheetFunction.RandBetween(1, 6)
ArrayDices(i, 2) = WorksheetFunction.RandBetween(1, 6)
If (ArrayDices(i, 1) = 1 And ArrayDices(i, 2) = 3) _
Or (ArrayDices(i, 1) = 1 And ArrayDices(i, 2) = 2) _
Or (ArrayDices(i, 1) = 3 And ArrayDices(i, 2) = 1) _
Or (ArrayDices(i, 1) = 2 And ArrayDices(i, 2) = 1) Then
ArrayResult(i) = 1
Else
ArrayResult(i) = 0
End If
Next i
'print the values to cells
Range("A1:B100000").Value = ArrayDices
Range("C1:C100000").Value = WorksheetFunction.Transpose(ArrayResult)
'Calculate the probability
Probability = Application.WorksheetFunction.Sum(ArrayResult) / 100000
MsgBox "The Probability is " & Probability
End Sub
The problem is that when I print the values from arrays to the cells, then in column C I have 0 and 1 (as it should be), but then from row 34465 I get NA. Here is a screenshot:
https://ibb.co/7jsjjJC
So, for some reason it starts putting NA instead of 0 and 1. The calculation does not work properly either, because the probability is too low, and I guess this is because it only counts the first 34464 zeros and ones, while dividing with 100 000. Can you help me understand what is wrong here? It seems to be a problem with (my understanding of) arrays, since I can run a similar simulation without arrays (by simply using cells), and it works.
Thanks in advance!
As #RaymondWu said in the comments, the problem is that the Transpose function has a limit to the length of the array it can manipulate. This limit is somewhere between 65k and 66k columns.
Indeed, your code will run as expected for 65k iterations.
You can easily avoid using transpose and to be honest I don't see the reason to use it in the first place.
Instead of declaring your array as Dim ArrayResult(1 To 100000) As Variant which by default makes it 1 row x 100000 columns, you can declare it as so:
Dim ArrayResult(1 To 100000, 1 To 1) As Variant
This will make it 100000 rows x 1 columns, which can now be written in a column in excel easily like so:
Range("C1:C100000").Value = ArrayResult
Of course you will also need to change the code accordingly where needed:
ArrayResult(i,1) = 1
Else
ArrayResult(i,1) = 0
A few other tips:
Always use Option Explicit at the very top of the code. It makes the declaration of variables mandatory and it helps to avoid mistakes
Always use explicit references. When referencing Ranges the best practice is to define the worksheet to which they belong e.g. ThisWorkbook.Worksheets("Sheet1").Range("C1:C100000").Value = ArrayResult
I'm running into a problem with a block of code I'm trying to develop at my job. Essentially, I'm creating a userform in excel where folks will enter data for railcars as they get loaded at a certain location (we'll call these "spot 1, spot 2, spot 3, etc.").
Sometimes they'll have to move that car to a different spot, in which case I want them to be able to keep all the information on the railcar from the first/original entry, and then erase the data from the original spot once that's done.
To accomplish this in a more streamlined fashion, I've established arrays for each of the 5 spots that reference all the cells they're entering data into on the userform:
Dim spot1information(14)
spot1information(0) = UserForm.ProductType1.Value
spot1information(1) = UserForm.ProductID1.Value
spot1information(2) = UserForm.BatchID1.Value
etc....
Dim spot2information(14)
spot2information(0) = UserForm.ProductType2.Value
spot2information(1) = UserForm.ProductID2.Value
spot2information(2) = UserForm.BatchID2.Value
etc....
And so forth for all five spots. I don't know if this makes things more difficult, but note that these array values aren't all of the same type. For instance, index (0) will be a string, but index (10) is a DATETIME and index (12) is defined as Long.
So say that they are moving a car from spot 1 to spot 2. In short, I want the code to do the following:
Replace the values of indices 0 - 6 in spot2information (which is currently empty) with the values of indices 0 - 6 in spot1information (which the user has filled on the userform).
I'm only interested in carrying over indices 0-6 because they contain the pertinent railcar information
Empty every value of spot1information to ""
To accomplish this, I tried the following code and a few variations thereof:
If OriginalSpot.Value = 1 Then
If DestinationSpot.Value = 2 Then
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
For Each i in spot1information
spot1information(i) = ""
Next
End If
End If
However, this keeps coming up with a type mismatch. I figure because the data in the spot2information array is empty, and the data in the spot1information array is not, but I'm not entirely sure of a way around this.
Update: I did what was suggested below and replaced: spot1information(i) = "" with Erase spot1information
The code now essentially works! The values of array "spot2information" are now the former values of "spot1information", with "spot1information" now empty.
The 2D array suggested below also works like a charm. New problem I've been facing is that array values are updating, but the userform isn't. (note: in the future I'll be posting this type of thing as a separate question, my apologies!)
Easier to manage this as a 2D array:
Sub Tester()
Dim spots(1 To 5, 0 To 14), n As Long, i As Long
'fill your spot arrays from the form....
For n = 1 To 5
spots(n, 0) = UserForm.Controls("ProductType" & n).Value
spots(n, 1) = UserForm.Controls("ProductID" & n).Value
spots(n, 2) = UserForm.Controls("BatchID" & n).Value
'etc etc
Next n
'swap a spot with another
Debug.Print spots(2, 1), spots(3, 1)
SwapSpots spots:=spots, fromSpot:=2, toSpot:=3
Debug.Print spots(2, 1), spots(3, 1)
End Sub
Sub SwapSpots(spots, fromSpot As Long, toSpot As Long)
Dim n As Long
For n = 0 To 6
spots(toSpot, n) = spots(fromSpot, n)
spots(fromSpot, n) = Empty 'empty the source slot value
Next n
End Sub
Assuming the DataType of the arrays is the same by Index i.e. index(0) is string for all spots, Index(2) is long for all spots, and so on.
If that is the case then this part should not produce any error:
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
The error should be happening in this part more precisely in the line marked with #
For Each i in spot1information
spot1information(i) = "" '#
Next
and the reason for the error it seems to be that trying to assign a string value "" to a numeric type, given the "mismatch" error.
Using For Each i in spot1information indicates that you want to "Initiate" or Erase the entire array, therefore I suggest to use this line instead of the For…Next method.
Erase spot1information
In regards this:
But I've now run into a new problem, where the values on the userform haven't updated to reflect the new values stored in the array. Do I need to somehow "refresh" the userform?
You just updated the arrays, then you need to run the procedures used to update the values of the objects affected by both arrays in the UserForm.
first question on this site.
Been coming here to bask in the warm glow of the knowledge on offer for years! Please be gentle with me. ;)
I'm not a programmer but can muddle my way around excel but I have a problem in excel that I'm struggling to find a solution to.
I need to take a set of data and turn it into an array (or list) of all the occurrences of that data. For example a set of data (A,B,C) and an instances value for each item (2,1,3).
What I need to do is take those two items and create an array of all occurrences.
Like this:-
Data,Instances
A,2
B,1
C,3
Total 6
Result
1,A
2,B
3,C
4,A
5,C
6,C
(I hope that's clear - my rating isn't high enough to post a screenshot)
So, in this example I have 2 As, 1 B and 3 Cs giving a total of 6 items. To create the result I've run through the list 6 times listing each data item if it still has an occurrence (but an array/list that was AABCCC would be just as valid). For the full data set there could be as many as 12 different data items with any number of occurrences each from 1 to 12.
Somehow I think I'm overcomplicating a simple process but for the life of me I can't get my head around achieving the result I need.
Say we put your data in column A:
and run this short macro:
Sub croupier()
Dim N As Long, K As Long, i As Long, ary(), bry()
Dim v As String
N = Cells(Rows.Count, "A").End(xlUp).Row
ReDim ary(1 To N)
ReDim bry(1 To N)
For i = 1 To N
v = Cells(i, "A").Value
cry = Split(v, ",")
ary(i) = cry(0)
bry(i) = CLng(cry(1))
Next i
K = 1
While Application.WorksheetFunction.Sum(bry) > 0
For i = 1 To N
If bry(i) <> 0 Then
Cells(K, "B").Value = ary(i)
bry(i) = bry(i) - 1
K = K + 1
End If
Next i
Wend
End Sub
Our result is this:
We repeatedly run down column A placing the values in column B until the count of an item reaches zero.
When the overall count of items is zero, we stop.
for example lets consider
a = fix(8 * randn(10,5));
and mean(a) would give me mean of each column.
So, what I was planning to do was comparing the mean of first column to each of its content till the column and and proceed to the next column with its mean and comparing with each of its content.
I was able to get this code here (I know there are multiple for loops but thats the best I could come up with, any alternate answer would be greatly accepted)
if(ndims(a)==2)
b = mean(a);
for c = 1:size(a,2)
for d = 1:size(a)
for e = 1:size(b,2)
if(a(d,c)>b(1,c))
disp(1);
else
disp(false);
end
end
end
end
else
disp('Input should be a 2D matrix');
end
I don't know if this is the right answer? Could any one tell me?
Thanks in advance.
It seems you want to know whether each entry is greater than its column-mean.
This is done efficiently with bsxfun:
result = bsxfun(#gt, a, mean(a,1));
Example:
a =
3 1 3 2
5 2 3 1
1 3 5 2
The column-means, given by mean(a,1), are
ans =
3.000000000000000 2.000000000000000 3.666666666666667 1.666666666666667
Then
>> result = bsxfun(#gt, a, mean(a,1))
result =
0 0 0 1
1 0 0 0
0 1 1 1
If you are trying to do what I think you are (print one if the average value of a column is greater than the value in that column, zero otherwise) you can eliminate a lot of loops doing the following (using your same a and b):
for ii=1:length(b)
c(:,ii) = b(ii) > a(:,ii);
end
c will be your array of ones and zeros.
11/24/14 - as per below.....
Still trying to figure this out - might it be easier by creating a smaller array which could roll through the larger array? ...then any necessary calcs could be done on the entirety of the small array.
I cannot figure out how to isolate just a (rolling) subset of an array. The rolling subset could be used for moving averages, standard devs, max/min, etc.
11/21/14 - I have made several attempts, this is the latest iteration. It shouldn't produce meaningful output until the minimum periods have been looped thru (stdev_periods = 10).
--pct_chg_array() is an array which holds percent change data from i=2 to i = 2541... declared as variant
--stdev_periods = 10 ...declared as integer
--i is a counter ...declared as integer
--stdev_array() is an empty array which I hope to populate with a standard deviation calculation for a rolling n period range ...declared as variant
--Option Base 1 and Option Explicit are on
For i = 2 To 2541
If IsNumeric(i) And i <> 0 Then
stdev_array(i, 1) = Application.WorksheetFunction.stdev(Range(pct_chg_array(i, 1).Offset(-stdev_periods, 0), pct_chg_array(i, 0)))
Else
stdev_array(i, 1) = 0
End If
Next i
Any guidance would be immensely appreciated. Thanks!
----EDIT----
Just to simplify, this is how I would express it in a worksheet formula...
=IF(ISNUMBER(OFFSET($E3,-stdev_periods+1,0)),STDEV(OFFSET($E3,0,0,-stdev_periods)),0)
...with "stdev_periods" = 10 and column E holding 1 period %chg data (ie =$E3/$E2-1).
Put this function in the module:
Public Function Slice(vntInputArray As Variant, lngStartIndex As Long, lngEndIndex As Long)
'Use to return an arbitrary-sized subset from a 1 dimensional array.
'Assumes developer is using Option Base 1
Dim vntSubArray() As Variant, lngInputIndex As Long
Dim lngElementCountIndex As Long: lngElementCountIndex = 1
For lngInputIndex = lngStartIndex To lngEndIndex
ReDim Preserve vntSubArray(lngInputIndex)
vntSubArray(lngElementCountIndex) = vntInputArray(lngInputIndex)
lngElementCountIndex = (lngElementCountIndex + 1)
Next lngInputIndex
Slice = vntSubArray
End Function
Adding the function to your code:
For i = 2 To 2541
If IsNumeric(i) And i > stdev_periods Then 'Using greater than to account for Option Base 1
stdev_array(i, 1) = WorksheetFunction.stdev(Slice( pct_chg_array, (i -stdev_periods), i))
Else
stdev_array(i, 1) = 0
End If
Next i