I need to calculate this in excel vba ,using array loop only :
round 0 round 1
9 28
65 84
28 47
84 103
41 60
66 85
115 134
I need to sum values in round 0 in loop so the sum result (408) must be divided by 7 , if not I WANT to sum one value from the round 1 (in this case 84 instead of 65 ) to the rest of values in round 0 so the sum result can divided by 7 . There will be so many round up to 7 . I need VBA code to accomplish this..
Notes :
round 0 and round 1 all in one two-dimensional array
My Question is : is there a way to sum values from different columns in multi-dimensional array ??
there is an image attached .
I appreciate any help or idea .
Thanks in advance
Excel VBA Array Model:
http://im56.gulfup.com/8rDErI.png
Here an example file contains macro "Question1.xlsm"
http://www.gulfup.com/?TKAAYM
Notes : click the link under the big green down arrow to download the file.
UPDATE :
here another macro to the file "Question1.xlsm" :
Sub A1()
Dim arrTemp1() As Integer
Dim sum1 As Integer
arrblkTable1 = Sheets("Sheet1").Range("blkTable1").Value
ReDim Preserve arrTemp1(0 To 1, 1 To 7)
For a = 0 To 1
sum1 = 0
For c = 1 To 7
arrTemp1(a, c) = arrblkTable1(c, 1) + (a * 19)
text6 = text6 & arrTemp1(a, c) & vbCrLf
Worksheets("TEST3").Cells(a + 1, c).Value = arrTemp1(a, c)
sum1 = sum1 + arrTemp1(a, c)
Next c
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1
Else
MsgBox "No " & sum1
End If
Next a
MsgBox text6
End Sub
Function XLMod(a, b)
' This replicates the Excel MOD function
XLMod = a - b * Int(a / b)
End Function
UPDATE : here a new update to the previous macro :
Sub A1()
Dim arrTemp1(), arrTemp2(), arrSUMs() As Integer
Dim sum1 As Integer
arrblkTable1 = Sheets("Sheet1").Range("blkTable1").Value
arrblkTable2 = Sheets("Sheet1").Range("blkTable2").Value
'-------------------------------- arrTemp1 ------------------------------
ReDim Preserve arrTemp1(0 To 1, 1 To 7)
For a = 0 To 1
sum1 = 0
For c = 1 To 7
arrTemp1(a, c) = arrblkTable1(c, 1) + (a * 19)
text6 = text6 & arrTemp1(a, c) & vbCrLf
Worksheets("TEST3").Cells(a + 1, c).Value = arrTemp1(a, c)
sum1 = sum1 + arrTemp1(a, c)
Next c
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1
Else
MsgBox "No " & sum1
For c = 1 To 7
sum1 = sum1 - arrTemp1(a, c)
arrTemp1(a, c) = arrblkTable1(c, 1) + ((a + 1) * 19)
sum1 = sum1 + arrTemp1(a, c)
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1 & " " & arrTemp1(a, c)
End If
Next c
End If
Next a
For x = 0 To UBound(arrTemp1)
For y = 1 To UBound(arrTemp1)
text7 = text7 & arrTemp1(x, y) & vbCrLf
Next y
Next x
MsgBox text7
End Sub
Function XLMod(a, b)
' This replicates the Excel MOD function
XLMod = a - b * Int(a / b)
End Function
I need now to put each sum1 in one array , how I can do that ??
If I understood it correctly you want something similar to this:
Sub p()
v = Range("A2:A8")
v1 = Sheets("Sheet1").Range("B2:B8")
s = Application.WorksheetFunction.Sum(v)
b = False
Count = 0
For i = 1 To 7
temp = v
temp(i, 1) = v1(i, 1)
s = Application.WorksheetFunction.Sum(temp)
b = s Mod 7 = 0
If b = True Then
Count = Count + 1
End If
Next
MsgBox Count
End Sub
It may help tremendously if you can give more detail about what problem you're trying to solve, instead of focusing on how to solve it this way. There is a possibility that there's another way of doing it that hasn't occurred to you that will be much simpler.
This isn't an answer. Yet. But it will take more space than is allowed in a comment to ensure we've got this right.
For your sample data:
round 0 round 1
9 28
65 84
28 47
84 103
41 60
66 85
115 134
You want to:
Sum all the values in Round 0 (9 + 65 + 28 + 84 + 41 + 66 + 115) = 408
Take that sum (408) mod 7 and see if the result is 0
408 / 7 = 58.28, so (408 mod 7) <> 0
If the result isn't 0 (as in this case)
Start substituting numbers from round 1 for numbers in Round 0
Sum (28 + 65 + 28 + 84 + 41 + 66 + 115) = 427
427 / 7 = 61 (427 mod 7) = 0
This is now your valid result set.
Had the first number in Round 1 been 29
Sum (29 + 65 + 28 + 84 + 41 + 66 + 115) = 428
428 / 7 = 61.14 so (428 mod 7) <> 0
Substitute the next number from round 1 for the next number from round 0
Sum (9 + 84 + 28 + 84 + 41 + 66 + 115) = 427
This is now your valid result set.
Is that the logic you're after?
What happens if you get to the end of round 1 and you don't find a total that (mod 7 = 0)?
Related
I have the same question as here: VBA counting multiple duplicates in array , but I haven't found an answer and with my reputation can't leave comment there.
I have an array with 150 numbers which could contain repetitive numbers from 1 to 50. Not always there are all 50 numbers in the array. Example of output of what I need:
- 10 times: 1, 2;
- 20 times: 3, 4 etc;
- 0 times: 5, 6, 7 etc.
I need to count how many combinations of duplicate numbers it has and what numbers are in those combinations including zero occurrence - which numbers are not in the array.
On mentioned above post there are solutions - but only when you know how many combinations of duplicates there are - and I don't know it - there could be 1 (all 150 numbers are equal) - ... - 20 ... up to 50 combinations if it contains all numbers from 1 to 50 three times each.
Appreciate any help and advice how to store output - finally it should be written to worksheet in the above mentioned format: [times] - [numbers] (here could be a string, example "5 - 6 - 7").
Here is what I've made for 5 combinations, but do 50 cases and then check 50 strings if they are empty or contain something to write to output is not very good option...
For i = 1 To totalNumbers 'my numbers from 1 to 50 or any other number
numberCount = 0
For j = 0 To UBound(friendsArray) 'my array of any size (in question said 150)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
Select Case numberCount
Case 0
zeroString = zeroString & i & " - "
Case 1
oneString = oneString & i & " - "
Case 2
twoString = twoString & i & " - "
Case 3
threeString = threeString & i & " - "
Case 4
fourString = fourString & i & " - "
Case 5
fiveString = fiveString & i & " - "
Case Else
End Select
Next i
I have found possible option using Collection (but have got an headache with getting keys of collection...):
Dim col As New Collection
For i = 1 To totalNumbers
numberCount = 0
For j = 0 To UBound(friendsArray)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
colValue = CStr(numberCount) & "> " & CStr(i) & " - " 'store current combination [key] and number as String
If IsMissing(col, CStr(numberCount)) Then
col.Add colValue, CStr(numberCount) 'if current combination of duplicates [key] is missing - add it to collection
Else 'if current combination [key] is already here - update the value [item]
oldValue = col(CStr(numberCount))
newValue = Replace(oldValue & colValue, CStr(numberCount) & "> ", "") 'delete combinations count
newValue = CStr(numberCount) & "> " & newValue
col.Remove CStr(numberCount) 'delete old value
col.Add newValue, CStr(numberCount) 'write new value with the same key
End If
Next i
For i = 1 To col.Count
Debug.Print col(i)
Next i
and IsMissing function (found here How to check the key is exists in collection or not)
Private Function IsMissing(col As Collection, field As String)
On Error GoTo IsMissingError
Dim val As Variant
val = col(field)
IsMissing = False
Exit Function
IsMissingError:
IsMissing = True
End Function
Output is like this [times]> [numbers]:
(array of 570 numbers)
114> 2 -
5> 6 -
17> 10 -
10> 3 - 8 - 19 - 21 - 30 -
6> 1 - 29 - 33 -
8> 5 - 9 - 13 - 23 - 25 - 28 - 37 - 40 -
4> 12 - 16 - 41 -
13> 43 -
12> 15 - 20 - 22 - 27 - 36 - 38 - 42 - 44 - 45 - 46 -
9> 4 - 7 - 11 - 14 - 34 - 47 - 48 -
7> 17 - 18 - 35 - 49 -
11> 24 - 26 - 31 - 32 - 39 - 50 -
Creating new array and count the number is more simple.
Sub test()
Dim friendsArray(0 To 50)
Dim vTable()
Dim iMax As Long
Dim a As Variant, b As Variant
Dim i As Long, s As Integer, n As Long
dim c As Integer
'Create Sample array to Test
n = UBound(friendsArray)
For i = 0 To n
friendsArray(i) = WorksheetFunction.RandBetween(0, 50)
Next i
'Your code
iMax = WorksheetFunction.Max(friendsArray)
ReDim vTable(0 To iMax) 'create new Array to count
For i = 0 To n
c = friendsArray(i)
vTable(c) = vTable(c) + 1
Next i
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To iMax
If IsEmpty(vTable(i)) Then
s = 0
Else
s = vTable(i)
End If
If dic.Exists(s) Then
dic.Item(s) = dic.Item(s) & " - " & i
Else
dic.Add s, i
End If
Next i
a = dic.Keys
b = dic.Items
Range("a1").CurrentRegion.Clear
Range("B:B").NumberFormatLocal = "#"
Range("a1").Resize(UBound(a) + 1) = WorksheetFunction.Transpose(a)
Range("b1").Resize(UBound(b) + 1) = WorksheetFunction.Transpose(b)
Range("a1").CurrentRegion.Sort Range("a1"), xlAscending
End Sub
so i have a task to create a square matrix then from that return the average of the rows and columns, having some problem though
Dim m, n, i, j As Integer
Dim A(2, 2) As Integer
Console.Write(vbLf & "Enter The Matrix Elements any two : ")
For i = 0 To 2 - 1
For j = 0 To 2 = 1
A(i, j) = Convert.ToInt16(Console.ReadLine())
Next
Next
Console.Clear()
Console.WriteLine(vbLf & "Matrix A : ")
For i = 0 To 2 - 1
For j = 0 To 2 - 1
Console.Write(vbLf & "{0}", A(i, j))
Next
Console.WriteLine(" ")
Next
Console.WriteLine(vbLf & "Transpose Matrix : ")
For i = 0 To 2 - 1
For j = 0 To 2 - 1
Console.Write(vbLf & "{0}", A(j, i))
Next
Console.WriteLine(" ")
Next
End Sub
This is my code, i know its supposed to be a square matrix so how would i do that, when i also try inputing the values it does not let me go past the next one, does anyone have code for a square matrix that gets its values from a user, or someone can help me please
To make it generic, use the GetUpperBound() function to determine how many elements are in your array for each dimension (it should be the same, however, since you have a square matrix):
Sub Main()
Dim size As Integer = 3
Dim numberWidth As Integer = 2
Dim format As String = "D" & numberWidth
Dim A(size - 1, size - 1) As Integer
For i As Integer = 0 To A.GetUpperBound(0)
For j As Integer = 0 To A.GetUpperBound(1)
Console.Write(String.Format("Enter The Matrix Element at A[Row {0}, Col {1}]: ", i, j))
A(i, j) = Convert.ToInt16(Console.ReadLine())
Next
Next
Console.WriteLine("Matrix A :")
For i As Integer = 0 To A.GetUpperBound(0)
Console.Write("| ")
For j As Integer = 0 To A.GetUpperBound(1)
Console.Write("{0} ", A(i, j).ToString(format))
Next
Console.WriteLine("|")
Next
Console.WriteLine("Transpose Matrix :")
For i As Integer = 0 To A.GetUpperBound(0)
Console.Write("| ")
For j As Integer = 0 To A.GetUpperBound(1)
Console.Write("{0} ", A(j, i).ToString(format))
Next
Console.WriteLine("|")
Next
Console.ReadLine()
End Sub
Output:
Enter The Matrix Element at A[Row 0, Col 0]: 1
Enter The Matrix Element at A[Row 0, Col 1]: 2
Enter The Matrix Element at A[Row 0, Col 2]: 3
Enter The Matrix Element at A[Row 1, Col 0]: 4
Enter The Matrix Element at A[Row 1, Col 1]: 5
Enter The Matrix Element at A[Row 1, Col 2]: 6
Enter The Matrix Element at A[Row 2, Col 0]: 7
Enter The Matrix Element at A[Row 2, Col 1]: 8
Enter The Matrix Element at A[Row 2, Col 2]: 9
Matrix A :
| 01 02 03 |
| 04 05 06 |
| 07 08 09 |
Transpose Matrix :
| 01 04 07 |
| 02 05 08 |
| 03 06 09 |
Here's a quick example of how to compute the SUM of each ROW:
Dim Total as Integer
For row As Integer = 0 To A.GetUpperBound(0)
Total = 0 ' reset for each row/column
For col As Integer = 0 To A.GetUpperBound(1)
Total = Total + A(row, col)
Next
Console.WriteLine("Row " & row & " total: " & Total)
' ... do something else with "Total" here; like compute an average ...
Next
The code for computing the total of columns will be very similar, just swap the positions of the For row and For col lines.
Below I have a list of “ID” numbers with their associated “Number “and their “values”. I am trying to create sub function that crates a dynamic array that collects all the “Values” that have a “Number” that is equal to and lesser than 30. After the array is filled it is summed and placed under the heading titled “30 or less”. I have been trying do this using VBA with no luck. I have read a bunch of posts and documents telling me how to do this but I can’t make sense of it. Could someone show me how to get this done. Its driving me crazy and I am sure its simple I eventually want to expand this to do the same with “Numbers ” that are greater than 30 but less than 60 and so on. Thank you
ID Number Value
0 60 100
1 31 101
2 12 102
3 30 103
4 21 104
5 60 105
30 or less
Try pasting this into a new module in VB.
This presumes that your Raw data is in Sheet(1) and sorted data will be in a new blank worksheet Sheet(2)
Sub AddNumbers()
Dim RowNo, ColNo As Long
'Skip Header Row
RowNo = 2
Do Until Sheets(1).Cells(RowNo, 1) = ""
If Sheets(1).Cells(RowNo, 2) <= 30 Then
Sheets(2).Cells(1, 1) = "30 or less"
ColNo = 1
Sheets(2).Cells((Sheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1), ColNo) = Sheets(1).Cells(RowNo, 3)
ElseIf Sheets(1).Cells(RowNo, 2) > 30 And Sheets(1).Cells(RowNo, 2) <= 60 Then
Sheets(2).Cells(1, 2) = "Between 30 and 60"
ColNo = 2
Sheets(2).Cells((Sheets(2).Cells(Rows.Count, 2).End(xlUp).row + 1), ColNo) = Sheets(1).Cells(RowNo, 3)
ElseIf Sheets(1).Cells(RowNo, 2) > 60 And Sheets(1).Cells(RowNo, 2) <= 90 Then
Sheets(2).Cells(1, 3) = "Between 60 and 90"
ColNo = 3
Sheets(2).Cells((Sheets(2).Cells(Rows.Count, 3).End(xlUp).row + 1), ColNo) = Sheets(1).Cells(RowNo, 3)
End If
RowNo = RowNo + 1
Loop
' Add Subtotals
ColNo = 1
Do Until Sheets(2).Cells(1, ColNo) = ""
Sheets(2).Cells((Sheets(2).Cells(Rows.Count, ColNo).End(xlUp).row + 1), ColNo).Formula = "=SUM(" & Col_Letter(ColNo) & "2:" & Col_Letter(ColNo) & (Sheets(2).Cells(Rows.Count, ColNo).End(xlUp).row) & ")"
Sheets(2).Cells((Sheets(2).Cells(Rows.Count, ColNo).End(xlUp).row), ColNo).Font.Bold = True
ColNo = ColNo + 1
Loop
End Sub
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
The time complexity of the following code is O(2^n), could you please explain to me why?
int f(int n)
{
if (n == 1)
return 1;
return 1 + f(f(n-1));
}
Thanks in advance
f(n) = n is a solution for this recurence relation
Proof:
f(n) = f(f(n-1)) + 1 = f(n-1) + 1 = (n-1) + 1 = n
Sample VBA code that verifies it:
Sub test()
For i = 1 To 20
Debug.Print i, f(i)
Next
End Sub
Function f(ByVal n As Long) As Long
If n = 1 Then
f = 1
Else
f = 1 + f(f(n - 1))
End If
End Function
Since we have established that f(n) = n, we can conclude that
f(n-1) = n-1
Assuming that it takes An calls to get f(n), An being a recurrence relation:
An = 1 + 2 * An-1
The call to calculate f(n)
The numbers of calls necessary to calculate f(n-1) which will return n-1
then the same number of calls to calculate f(f(n-1)) since we are calling f with n-1 again.
The solution of the recurrence relation is 2^n - 1
Cost complexity is 2^n -1
VBA Code:
Option Explicit
Dim count As Long
Sub test()
Dim i As Integer
For i = 1 To 20
count = 0
f i
Debug.Print i, count
Next
End Sub
Function f(ByVal n As Long) As Long
count = count + 1
If n = 1 Then
f = 1
Else
f = 1 + f(f(n - 1))
End If
End Function
Output:
1 1
2 3
3 7
4 15
5 31
6 63
7 127
8 255
9 511
10 1023
11 2047
12 4095
13 8191
14 16383
15 32767
16 65535
17 131071
18 262143
19 524287
20 1048575
How can I "Sort" the multidimensional arrays based on the hole size parameter please?
eg: A simple example would be (Loaded from Text file):
> Liv1.HoleSize[0] = 22 Liv1.HoleX[0] = 250 Liv1.HoleY[0] = -55
> Liv1.HoleSize[1] = 14 Liv1.HoleX[1] = 750 Liv1.HoleY[1] = 0
> Liv1.HoleSize[2] = 22 Liv1.HoleX[2] = 900 Liv1.HoleY[2] = -55
must then result in :
> Liv1.HoleSize[0] = 14 Liv1.HoleX[0] = 750 Liv1.HoleY[0] = 0
> Liv1.HoleSize[1] = 22 Liv1.HoleX[1] = 250 Liv1.HoleY[1] = -55
> Liv1.HoleSize[2] = 22 Liv1.HoleX[2] = 900 Liv1.HoleY[2] = -55
As VBScript has no native sort, you'll have to roll your own sort, or to get a little help from friends.
If your task is to sort your input file (verbatim as given) to an output file in the specified order, sort.exe is your friend:
Dim sIn : sIn = "..\data\in00.txt"
WScript.Echo readAllFromFile(sIn)
WScript.Echo "-----------"
Dim sCmd : sCmd = "sort /+19 " & qq(resolvePath(sIn))
Dim aRet : aRet = goWSLib.Run(sCmd)
If aRet(0) Then
' handle error
Else
WScript.Echo aRet(2)
End If
output:
================================================================
Liv1.HoleSize[0] = 22 Liv1.HoleX[0] = 250 Liv1.HoleY[0] = -55
Liv1.HoleSize[1] = 14 Liv1.HoleX[1] = 750 Liv1.HoleY[1] = 0
Liv1.HoleSize[2] = 22 Liv1.HoleX[2] = 900 Liv1.HoleY[2] = -55
-----------
Liv1.HoleSize[1] = 14 Liv1.HoleX[1] = 750 Liv1.HoleY[1] = 0
Liv1.HoleSize[0] = 22 Liv1.HoleX[0] = 250 Liv1.HoleY[0] = -55
Liv1.HoleSize[2] = 22 Liv1.HoleX[2] = 900 Liv1.HoleY[2] = -55
================================================================
If something like that solves your problem, just say so, and we can talk the support code in the library functions.
If, however, you have (to) parse(d) the input file into a two-dimensional array, the best friend you can get is a disconnectes ADODB recordset:
Dim aData : aData = Split(Join(Array( _
"22 250 -55" _
, "14 750 0" _
, "22 900 -55" _
, "11 222 333" _
)))
Dim afData(3, 2)
Dim nRows : nRows = UBound(afData, 1)
Dim nCols : nCols = UBound(afData, 2)
Dim i, r, c
For i = 0 TO UBound(aData)
r = i \ nRows
c = i Mod (nCols + 1)
afData(r, c) = aData(i)
' WScript.Echo i, r, c, aData(i)
Next
For r = 0 To nRows
For c = 0 To nCols
WScript.StdOut.Write vbTab & afData(r, c)
Next
WScript.Echo
Next
WScript.Echo "-----------------"
Dim oRS : Set oRS = CreateObject("ADODB.Recordset")
For c = 0 To nCols
oRS.Fields.Append "Fld" & c, adInteger
Next
oRS.Open
For r = 0 To nRows
oRS.AddNew
For c = 0 To nCols
oRS.Fields(c).value = afData(r, c)
Next
oRS.UpDate
Next
oRS.Sort = "Fld0"
WScript.Echo oRS.GetString(adClipString, , vbTab, vbCrLf)
WScript.Echo "-----------------"
oRS.Sort = "Fld2"
WScript.Echo oRS.GetString(adClipString, , vbTab, vbCrLf)
output:
========================================
22 250 -55
14 750 0
22 900 -55
11 222 333
-----------------
11 222 333
14 750 0
22 250 -55
22 900 -55
-----------------
22 250 -55
22 900 -55
14 750 0
11 222 333
========================================
Again: if that looks promising, we can discuss how to adapt/streamline this proof of concept code to your needs.