how to multiply two dimensional a(5,3) and b (3,5)
so the arry c( , )= a(5,3) and b (3,5)
the first row of arry a * the columns of arry b then
the second row of arry a * the columns of arry b then
[EDIT] the code of your comment:
Dim arry1(5, 3) As Integer
Dim arry2(3, 5) As Integer
Dim i, j As Integer
For i = 1 To 5
For j = 1 To 3
arry1(i, j) = Int(9 * Rnd + 1)
Next i, j
For i = 1 To 3
For j = 1 To 5
arry2(i, j) = Int(9 * Rnd + 1)
Next i, j
Congrats! it works :)
Some comments:
when you use Dim a, b As Integer then b will be an Integer, but a will be a Variant. It is better to use Dim a As Integer, b As Integer so that both a and b will be Integers
why do you ReDim c(5, 5) As Integer ? You can use Dim c(5, 5) As Integer
Instead of printing to the form I would show the data in a textbox or label control
Dim a, b As Integer
Dim arry1(5, 3) As Integer
Dim arry2(3, 5) As Integer
ReDim c(5, 5) As Integer
Dim i, j, s As Integer
Print ""
Print Space(15); "the first arry"
Print ""
For i = 1 To 5
For j = 1 To 3
arry1(i, j) = Int(9 * Rnd + 1)
Print Space(3); arry1(i, j);
Next j
Print ""
Next i
Print ""
Print Space(15); " the second arry"
Print ""
For i = 1 To 3
For j = 1 To 5
arry2(i, j) = Int(9 * Rnd + 1)
Print Space(3); arry2(i, j);
Next j
Print ""
Next i
Print ""
Print Space(15); " the result"
Print ""
cmd1.Visible = False
For a = 1 To 5
For b = 1 To 5
For j = 1 To 3
s = s + (arry1(b, j) * arry2(j, a))
c(a, b) = s
Next j
s=0
Next b
Next a
For i = 1 To 5
For j = 1 To 5
Print Space(3); c(i, j);
Next j
Print ""
Next i
thank you for your answers i solved the problem by may self and its pleasure me if you tel your openion in my code ... thank you
Related
I need to loop in a range (in my case column A) to get following results:
A B
1 = 2 - 1
2 = 3 - 1
3 = 3 - 2
4 = 4 - 1
5 = 4 - 2
= 4 - 3
= 5 - 1
= 5 - 2
= 5 - 3
= 5 - 4
I want number 5 to be deducted by 4, 3, 2 ,1 and then number 4 by 3, 2, 1 and so on.
I was somehow able to achieve this with collection but since dataset is rather big script is running 30+ minutes.
At this point I'm trying to figure out arrays but I don't know how to get desired result. My main concern is whether I can loop from bottom to top (From number 5 to 1, not 1 to 5) and how to fixate last row (fix number 5, conduct deductions and then fix number 4, do math magic and loop to 3 and so on).
My current code is:
Dim Arr As Variant
Dim lastc, lastr As Long
lastc = FindColNumber
lastr = ws.Cells(ws.Rows.count, lastc).End(xlUp).Row
Arr = ws.Range(ws.Cells(2, last), ws.Cells(lastr, lastc))
For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
If (Arr(i, 1) > 0) And (Arr(i + 1, 1) > Arr(i, 1)) Then
Arr(i, 1) = Arr(i, 1) - Arr(i + 1, 1)
Code does deduction as following: 5-4, 4-3, 3-2, 2-1 and that's not what I need.
Any tips?
Thank you.
As stated in the comments, you will need two loops and another output array:
Sub lkjlkjkdl()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim Arr As Variant
Dim lastc As Long, lastr As Long
lastc = 1 'FindColNumber
lastr = ws.Cells(ws.Rows.Count, lastc).End(xlUp).Row
Arr = ws.Range(ws.Cells(2, lastc), ws.Cells(lastr, lastc))
Dim cnt As Long
cnt = ((UBound(Arr, 1) - 1) * UBound(Arr, 1)) / 2
Dim k As Long
k = 1
Dim outarr As Variant
ReDim outarr(1 To cnt, 1 To 1)
For i = LBound(Arr, 1) + 1 To UBound(Arr, 1)
Dim j As Long
For j = LBound(Arr, 1) To i - 1
outarr(k, 1) = Arr(i, 1) - Arr(j, 1)
k = k + 1
Next j
Next i
ws.Range("B2").Resize(cnt, 1).Value = outarr
End Sub
I'm trying to assign a 1-dimensional array's values to cell range.
For example; my array has 23 items (every item randomized from 1 to 5) and my cell range is range A1 to I7.
I want to assign every value of my array to this cell range randomly.
I randomize the cell values with my array but my array's values are not completely assigned to cells.
Sub define_ore_body()
Dim lb_grade As Integer, ub_grade As Integer
Dim ore_body(1 To 23) As Variant
Dim i As Integer, j As Integer, k As Integer
Dim a As Object
Dim b As Range
Application.ScreenUpdating = False
'my selected range area A1toI7
Set b = Application.Range("A1:I7")
Set a = Application.Cells
'******* low and high ore bound ******
lb_grade = InputBox("Enter lowest ore grade:")
ub_grade = InputBox("Enter highest ore grade:")
'The reason why I do it as follows is that if the random lower bound does not start from 1,
'the largest random number it generates is 2 more than the value I have entered, so
If lb_grade > 1 Then
ub_grade = ub_grade - 2
End If
'******* Random Array ******
'array has 23 items
For i = 1 To 23
ore_body(i) = Int((ub_grade * Rnd) + lb_grade)
Next i
'******* filling random cells with my array******
k = 1
For Each a In b
If a.Value = "" And k < 23 Then
b(Int(7 * Rnd + 1), (8 * Rnd + 1)) = ore_body(k)
ElseIf a.Count > 23 And k > 23 Then
Exit For
Else
k = k + 1
End If
Next a
'******* after filling cell now fill empty cells with Zero******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) = "" Then
Cells(i, j) = 0
Else
End If
Next j
Next i
'******* Coloring only containing array values******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) > 0 Then
Application.Cells(i, j).Interior.ColorIndex = 38
Else
End If
Next j
Next i
End Sub
The array contains 23 items that initialize to Variant/Empty:
Dim ore_body(1 To 23) As Variant
Make that 63 items that initialize to 0:
Dim ore_body(1 To 63) As Long
The rest of the code will now populate the first 23 elements, because that's what the loop does:
For i = 1 To 23
If you want the loop to run through all indexes, consider using LBound and UBound operators to programmatically retrieve the lower and upper boundaries of the array, respectively:
For i = LBound(ore_body) To UBound(ore_body)
Note that you have 23 hard-coded in several places, which is going to make it harder than necessary to modify if/when that 23 needs to be come a 25. Consider replacing every occurrence of it by a Const:
Const ElementCount As Long = 23
Then every instance of 23 can become ElementCount, and then when it needs to become 25 then there's only one place that needs any code to change.
Loop through the array.
Set a to a random cell in the range A1:I7.
If cell is empty put the value from the array in the cell, if it
isn't repeat step 2
Sub define_ore_body()
Dim lb_grade As Integer, ub_grade As Integer
Dim ore_body(1 To 23) As Variant
Dim i As Long, j As Long, k As Long
Dim a As Range
Dim b As Range
Application.ScreenUpdating = False
'my selected range area A1:I7
Set b = Application.Range("A1:I7")
' clear A1:A17
b.Clear
'******* low and high ore bound ******
lb_grade = InputBox("Enter lowest ore grade:")
ub_grade = InputBox("Enter highest ore grade:")
'The reason why I do it as follows is that if the random lower bound does not start from 1,
'the largest random number it generates is 2 more than the value I have entered, so
If lb_grade > 1 Then
ub_grade = ub_grade - 2
End If
'******* Random Array ******
'array has 23 items
For i = 1 To 23
ore_body(i) = Int((ub_grade * Rnd) + lb_grade)
Next i
'******* filling random cells with my array******
For k = 1 To 23
Do
Set a = b.Cells(Int(7 * Rnd) + 1, Int(9 * Rnd) + 1)
Loop Until a.Value = ""
a.Value = ore_body(k)
Next k
'******* after filling cell now fill empty cells with Zero******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) = "" Then
Cells(i, j) = 0
Else
End If
Next j
Next i
'******* Coloring only containing array values******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) > 0 Then
Application.Cells(i, j).Interior.ColorIndex = 38
Else
End If
Next j
Next i
End Sub
I have a code in the console that orders an array, but only if the number is positive, if I enter a negative, it only places it in 0, also, the second array must be empty, but if I put a 0 in the position of the array that is greater at that moment and there is another position with the same number, they both turn to 0, how can I solve these two problems?(I used translate google for this question)
Module Module1
Sub Main()
Dim Array(4) As Double
Dim Order(4) As Integer
Dim j As Integer = 0
Dim Higher As Integer
Console.WriteLine("Type 5 integer.")
For i = 0 To Array.Length - 1
Console.Write(i & "> ")
Array(i) = Console.ReadLine
If Array(i) Mod 1 = 0 Then
Else
Console.WriteLine("Please, type only a integer.")
i = i - 1
End If
Next
Do While j < 5
For i = 0 To 4
Higher= Max(Higher, Array(i))
Next
For i = 0 To 4
If Higher = Array(i) Then
Array(i) = 0
End If
Next
Order(j) = Higher
j = j + 1
Higher = -32768
Loop
I have a little problem with my sub. This sub is calling to different functions, by using the sub's data. The first function finds one is finding the amount of unique values and the second function finds these values. However, the first function works fine because its output is a scalar value. However, the second function's output is an array. I have tried to search for a solution, but so far I have not succeeded. I have a theory that the issue has something to do with the ByRef A() As Integer. I have written the codes below, both for the sub and the second function.
Sub Test()
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '5 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A) 'Unikke is the second function that provides the amount of unique values
Dim FF() As Integer
ReDim FF(BB, 1)
FF = HvilkeUnikke(A) 'the second function, which has the output of an array a.k.a the problem
End Sub
This is the function:
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB, 1)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B, 1) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
The results are as expected, but they should be in a variable inside my sub.
(The solution)
Sub test()
Dim FF() As Integer
Dim i As Integer
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '7 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A)
ReDim FF(BB)
FF = HvilkeUnikke(A)
'Testing on the worksheet
For i = 1 To BB
Cells(i, 1) = FF(i)
Next
End Sub
And the function
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer()
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
I want to create a piece of code that lets me assign a value from a array to another array, which are of different lengths. This is what I have so far.
A(1) = 0
A(2) = 0
A(3) = 6
A(4) = 5
A(5) = 7
n = 0
For i = 1 To 5
If A(i) <> 0 Then
n = n + 1
End If
Next i
ReDim B(1 To n) As Integer
For j = 1 To n
For i = 1 To 5
If A(i) <> 0 Then
B(j) = A(i)
End If
Next i
Next j
MsgBox B(2)
At the moment this returns 7 whereas it should return 5, all values in B are 7. How can I get this code to run?
The fact that you have nested loops should alarm you: this would be executed n * 5 times, which cannot be correct.
Change the second part so it only uses one loop, like this:
ReDim B(1 To n) As Integer
j = 1
For i = 1 To UBound(A)
If A(i) <> 0 Then
B(j) = A(i)
j = j + 1
End If
Next i
Note also that using UBound instead of 5 makes your code more generic. Note also that this loop is very similar to the loop that calculates n. The only difference is that you assign to B(j).
You could in fact combine it with the first loop, if you would re-dimension B twice, the second time with Preserve:
ReDim B(1 To UBound(A)) As Integer
n = 0
For i = 1 To UBound(A)
If A(i) <> 0 Then
n = n + 1
B(n) = A(i)
End If
Next i
' Shorten the array without losing data:
ReDim Preserve B(1 To n)
You are going to have to check B for the first empty array element and exit the loop so you do not continue to write.
Dim A() As Variant, B() As Variant
Dim i As Long, j As Long, n As Long
A = Array(0, 0, 6, 5, 7) '<~~ 0 to 4, not 1 to 5
n = 0
For i = LBound(A) To UBound(A)
If A(i) <> 0 Then
n = n + 1
End If
Next i
ReDim B(1 To n) '<~~ 1 to 3
For i = LBound(A) To UBound(A)
If A(i) <> 0 Then
For j = LBound(B) To UBound(B)
If IsEmpty(B(j)) Then
B(j) = A(i) '<~~ assigned a value; exit loop
Exit For
End If
Next j
End If
Next i
For j = LBound(B) To UBound(B)
Debug.Print B(j)
Next j
Given that arrays can be either zero-based or one-based, I prefer to use the LBound and UBound functions to define their scope.