VB beginner here.
The array i need to create is 3 columns, 100 rows.
The first column will be an integer that increases by two for every row.
The second column will be a date that increases by 15 days.
The third column is similarly like the second column but begins from another day.
I have some codes below I tried but is still lost at what that will do.
Very grateful if you can help me out on this.
Private Sub AutopayPayPeriod()
Dim row As Int32
Dim AutopayArray(0 To 10, 0 To 2)
Dim RCN As Int32 = row
Dim PayPeriodStart, PayPeriodEnd As Date
Dim index As Int32
RCN = 1
PayPeriodStart = Format(#12/12/2015#, "Short Date")
PayPeriodEnd = Format(#12/25/2015#, "Short Date")
For index = 1 To AutopayArray.Length - 1
AutopayArray(0, 2) = {RCN, PayPeriodStart, PayPeriodEnd}
PayPeriodStart = PayPeriodStart.AddDays(15)
PayPeriodEnd = PayPeriodEnd.AddDays(15)
RCN += 2
index += 1
Array.Resize(ByRef AutopayArray, (AutopayArray.Length+=1))
Next
End Sub
A multidimensional array is the wrong data structure for this because you have different data types. Also, having a plain array in your code obscures the intent of the code since nobody can guess what the entries mean without proper documentation.
What you should use is a properly typed Class or Structure, depending on how you are using it. In the following, I show the variant with a Class:
Class PeriodInformation
Public Property RCN As Integer
Public Property StartDate As Date
Public Property EndDate As Date
End Class
The second thing you might want to change is to use a List(Of PeriodInformation) instead of an array because adding and removing items is much simpler. If you stick to the array, resize it once at the beginning instead of every time.
And finally, don't use string representations of dates. Use the actual dates.
The code then look as follows:
Private Function AddAutoPayPeriods(firstPayPeriodStart As Date, firstPayPeriodEnd As Date, firstPayPeriodRCN As Integer, numberOfPeriods As Integer) As List(Of PeriodInformation)
Dim result As New List(Of PeriodInformation)
For i As Integer = 1 To numberOfPeriods
result.Add(New PeriodInformation With {.RCN = firstPayPeriodRCN, .StartDate = firstPayPeriodStart, .EndDate = firstPayPeriodEnd})
firstPayPeriodStart = firstPayPeriodStart.AddDays(15)
firstPayPeriodEnd = firstPayPeriodEnd.AddDays(15)
firstPayPeriodRCN += 2
Next
Return result
End Function
We could then call this function like:
Dim periods = AddAutoPayPeriods(#12/12/2015#, #12/25/2015#, 1, 10)
And finally check what we've got by simply printing all elements:
For Each period In periods
Console.WriteLine($"{period.RCN}: {period.StartDate:d} - {period.EndDate:d}")
Next
Which prints
1: 12-Dec-15 - 25-Dec-15
3: 27-Dec-15 - 09-Jan-16
5: 11-Jan-16 - 24-Jan-16
7: 26-Jan-16 - 08-Feb-16
9: 10-Feb-16 - 23-Feb-16
11: 25-Feb-16 - 09-Mar-16
13: 11-Mar-16 - 24-Mar-16
15: 26-Mar-16 - 08-Apr-16
17: 10-Apr-16 - 23-Apr-16
19: 25-Apr-16 - 08-May-16
Another helpful class in .net is the DataTable. When dealing with rows and columns it may be a good fit.
Private Function CreatePayPeriods(RCN As Integer, PayPeriodStart As Date, PayPeriodEnd As Date, NumberOfPeriods As Integer) As DataTable
Dim dt As New DataTable()
dt.Columns.Add("RCN", GetType(Integer))
dt.Columns.Add("Pay Period Start Date", GetType(Date))
dt.Columns.Add("Pay Period End Date", GetType(Date))
For i = 1 To NumberOfPeriods
dt.Rows.Add(RCN, PayPeriodStart, PayPeriodEnd)
PayPeriodStart = PayPeriodStart.AddDays(15)
PayPeriodEnd = PayPeriodEnd.AddDays(15)
RCN += 2
Next
Return dt
End Function
To see the results
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
DataGridView1.DataSource = CreatePayPeriods(1, #1/02/2017#, #1/9/2017#, 100)
End Sub
Please try with this method:
Private Sub AutopayPayPeriod()
Dim myArray(2) 'as colomns
Dim myRows As New ArrayList 'as rows
Dim PayPeriodStart = Format(#12/12/2015#, "Short Date")
Dim PayPeriodEnd = Format(#12/25/2015#, "Short Date")
For myIdx = 1 To 100
myArray = {(myIdx - 1) * 2 + 1, PayPeriodStart, PayPeriodEnd}
PayPeriodStart = Format(CDate(PayPeriodStart).AddDays(15), "Short Date")
PayPeriodEnd = Format(CDate(PayPeriodEnd).AddDays(15), "Short Date")
myRows.Add(myArray)
Next
For myIdx = 1 To 100
Debug.Print(myRows.Item(myIdx - 1)(0) & ", " & myRows.Item(myIdx - 1)(1) & ", " & myRows.Item(myIdx - 1)(2))
Next
End Sub
The Result are as follows:
1, 12/12/2015, 12/25/2015
3, 12/27/2015, 1/9/2016
5, 1/11/2016, 1/24/2016
7, 1/26/2016, 2/8/2016
9, 2/10/2016, 2/23/2016
11, 2/25/2016, 3/9/2016
13, 3/11/2016, 3/24/2016
15, 3/26/2016, 4/8/2016
17, 4/10/2016, 4/23/2016
19, 4/25/2016, 5/8/2016
21, 5/10/2016, 5/23/2016
23, 5/25/2016, 6/7/2016
25, 6/9/2016, 6/22/2016
27, 6/24/2016, 7/7/2016
29, 7/9/2016, 7/22/2016
31, 7/24/2016, 8/6/2016
33, 8/8/2016, 8/21/2016
35, 8/23/2016, 9/5/2016
37, 9/7/2016, 9/20/2016
39, 9/22/2016, 10/5/2016
41, 10/7/2016, 10/20/2016
43, 10/22/2016, 11/4/2016
45, 11/6/2016, 11/19/2016
47, 11/21/2016, 12/4/2016
49, 12/6/2016, 12/19/2016
51, 12/21/2016, 1/3/2017
53, 1/5/2017, 1/18/2017
55, 1/20/2017, 2/2/2017
57, 2/4/2017, 2/17/2017
59, 2/19/2017, 3/4/2017
61, 3/6/2017, 3/19/2017
63, 3/21/2017, 4/3/2017
65, 4/5/2017, 4/18/2017
67, 4/20/2017, 5/3/2017
69, 5/5/2017, 5/18/2017
71, 5/20/2017, 6/2/2017
73, 6/4/2017, 6/17/2017
75, 6/19/2017, 7/2/2017
77, 7/4/2017, 7/17/2017
79, 7/19/2017, 8/1/2017
81, 8/3/2017, 8/16/2017
83, 8/18/2017, 8/31/2017
85, 9/2/2017, 9/15/2017
87, 9/17/2017, 9/30/2017
89, 10/2/2017, 10/15/2017
91, 10/17/2017, 10/30/2017
93, 11/1/2017, 11/14/2017
95, 11/16/2017, 11/29/2017
97, 12/1/2017, 12/14/2017
99, 12/16/2017, 12/29/2017
101, 12/31/2017, 1/13/2018
103, 1/15/2018, 1/28/2018
105, 1/30/2018, 2/12/2018
107, 2/14/2018, 2/27/2018
109, 3/1/2018, 3/14/2018
111, 3/16/2018, 3/29/2018
113, 3/31/2018, 4/13/2018
115, 4/15/2018, 4/28/2018
117, 4/30/2018, 5/13/2018
119, 5/15/2018, 5/28/2018
121, 5/30/2018, 6/12/2018
123, 6/14/2018, 6/27/2018
125, 6/29/2018, 7/12/2018
127, 7/14/2018, 7/27/2018
129, 7/29/2018, 8/11/2018
131, 8/13/2018, 8/26/2018
133, 8/28/2018, 9/10/2018
135, 9/12/2018, 9/25/2018
137, 9/27/2018, 10/10/2018
139, 10/12/2018, 10/25/2018
141, 10/27/2018, 11/9/2018
143, 11/11/2018, 11/24/2018
145, 11/26/2018, 12/9/2018
147, 12/11/2018, 12/24/2018
149, 12/26/2018, 1/8/2019
151, 1/10/2019, 1/23/2019
153, 1/25/2019, 2/7/2019
155, 2/9/2019, 2/22/2019
157, 2/24/2019, 3/9/2019
159, 3/11/2019, 3/24/2019
161, 3/26/2019, 4/8/2019
163, 4/10/2019, 4/23/2019
165, 4/25/2019, 5/8/2019
167, 5/10/2019, 5/23/2019
169, 5/25/2019, 6/7/2019
171, 6/9/2019, 6/22/2019
173, 6/24/2019, 7/7/2019
175, 7/9/2019, 7/22/2019
177, 7/24/2019, 8/6/2019
179, 8/8/2019, 8/21/2019
181, 8/23/2019, 9/5/2019
183, 9/7/2019, 9/20/2019
185, 9/22/2019, 10/5/2019
187, 10/7/2019, 10/20/2019
189, 10/22/2019, 11/4/2019
191, 11/6/2019, 11/19/2019
193, 11/21/2019, 12/4/2019
195, 12/6/2019, 12/19/2019
197, 12/21/2019, 1/3/2020
199, 1/5/2020, 1/18/2020
Another ways are:
Private Sub AutopayPayPeriod()
Dim myArray(2) 'as colomns
Dim myRows As New Collection'as rows
Dim PayPeriodStart = Format(#12/12/2015#, "Short Date")
Dim PayPeriodEnd = Format(#12/25/2015#, "Short Date")
For myIdx = 1 To 100
myArray = {(myIdx - 1) * 2 + 1, PayPeriodStart, PayPeriodEnd}
PayPeriodStart = Format(CDate(PayPeriodStart).AddDays(15), "Short Date")
PayPeriodEnd = Format(CDate(PayPeriodEnd).AddDays(15), "Short Date")
myRows.Add(myArray)
Next
For myIdx = 1 To 100
Debug.Print(myRows.Item(myIdx)(0) & ", " & myRows.Item(myIdx)(1) & ", " & myRows.Item(myIdx)(2))
Next
End Sub
But the best way it to use table as Mary said
Related
Dear Stackoverflow experts,
I am trying to write a code that will let me select a number of shapes, then prompt me what color should I fill up for each selected shape.
While the following code work well for me
Sub ChangeColorBasedonInput()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer
myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)
On Error Resume Next
z = ActiveWindow.Selection.ShapeRange.Count
For x = 1 To z
With ActiveWindow.Selection.ShapeRange(x)
colorChoice = InputBox("Please select the color you want for Shape " & x & ", from 1 - 10")
.Fill.ForeColor.RGB = myColor(colorChoice)
End With
Next x
End Sub
I realize its quite hassle to have to enter the color choice one by one, so I try to write the code below so that I only need to enter my fill color selection once (from the above array and it will automatically fill up the shapes for me. eg when I select 7, I hope it fills the shapes from myColor(7) onwards. But somehow the following codes doesn't work. Wonder if anyone could point out my mistake here.
Sub ChangeColorBasedon_EnterOnceOnly()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer
myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)
On Error Resume Next
z = ActiveWindow.Selection.ShapeRange.Count
colorChoice = InputBox("Please select the color you want for Shape " & x + 1 & ", from 1 - 10")
For x = 1 To z
With ActiveWindow.Selection.ShapeRange(x)
.Fill.ForeColor.RGB = myColor(colorChoice)
End With
colorChoice = colorChoice + x
Next x
End Sub
Just before Next x add
If colorChoice > UBound(myColor) Then colorChoice = LBound(myColor)
or you may exceed the bounds of the array if too many shapes are selected
I have some legacy files that need mined for data. The files were created by Lotus123 Release 4 for DOS. I'm trying to read the files faster by parsing the bytes rather than using Lotus to open the files. I have value records of 10 bytes each. They are 80 bit Extended Precision Floating Point.
Debug.Print(ConvertLongDouble80(New Byte() {0, 0, 0, 0, 0, 0, 0, 128, 255, 191})) ' Value = -1
Debug.Print(ConvertLongDouble80(New Byte() {205, 204, 204, 204, 204, 204, 204, 204, 251, 191})) ' Value = -0.1
Debug.Print(ConvertLongDouble80(New Byte() {10, 215, 163, 112, 61, 10, 215, 163, 248, 191})) ' Value = -0.01
Debug.Print(ConvertLongDouble80(New Byte() {59, 223, 79, 141, 151, 110, 18, 131, 245, 191})) ' Value = -0.001
Debug.Print(ConvertLongDouble80(New Byte() {44, 101, 25, 226, 88, 23, 183, 209, 241, 191})) ' Value = -0.0001
Debug.Print(ConvertLongDouble80(New Byte() {35, 132, 71, 27, 71, 172, 197, 167, 238, 191})) ' Value = -0.00001
Debug.Print(ConvertLongDouble80(New Byte() {182, 105, 108, 175, 5, 189, 55, 134, 235, 191})) ' Value = -0.000001
Debug.Print(ConvertLongDouble80(New Byte() {0, 0, 0, 0, 0, 0, 0, 128, 255, 63})) ' Value = 1
Debug.Print(ConvertLongDouble80(New Byte() {205, 204, 204, 204, 204, 204, 204, 204, 251, 63})) ' Value = 0.1
Debug.Print(ConvertLongDouble80(New Byte() {10, 215, 163, 112, 61, 10, 215, 163, 248, 63})) ' Value = 0.01
Debug.Print(ConvertLongDouble80(New Byte() {59, 223, 79, 141, 151, 110, 18, 131, 245, 63})) ' Value = 0.001
Debug.Print(ConvertLongDouble80(New Byte() {44, 101, 25, 226, 88, 23, 183, 209, 241, 63})) ' Value = 0.0001
Debug.Print(ConvertLongDouble80(New Byte() {35, 132, 71, 27, 71, 172, 197, 167, 238, 63})) ' Value = 0.00001
Debug.Print(ConvertLongDouble80(New Byte() {182, 105, 108, 175, 5, 189, 55, 134, 235, 63})) ' Value = 0.000001
Debug.Print(ConvertLongDouble80(New Byte() {188, 66, 122, 229, 213, 148, 191, 214, 231, 63})) ' Value = 0.0000001
Function ConvertLongDouble80(ByVal TenBytes As Byte()) As Double
'https://en.wikipedia.org/wiki/Extended_precision
'get 15 bit exponent; remove the first bit which is the negative sign
Dim arrExp As Byte() = New Byte() {TenBytes(8), (TenBytes(9) << 1) >> 1}
Dim Expo As UInt16 = BitConverter.ToUInt16(arrExp, 0)
'flag bits
Dim Bit63 As UInt16 = Convert.ToUInt16(TenBytes(7) >> 7)
Dim Bits63_62 As UInt16 = Convert.ToUInt16(TenBytes(7) >> 6)
'fractional values
TenBytes(7) = (TenBytes(7) << 1) >> 1
Dim Bits62_0 As UInt64 = BitConverter.ToUInt64(TenBytes, 0)
TenBytes(7) = (TenBytes(7) << 2) >> 2
Dim Bits61_0 As UInt64 = BitConverter.ToUInt64(TenBytes, 0)
If Bit63 = 0 and Bits62_0 = 0 Then
Return 0
Else
Const ExponentBias As Integer = 16383
Dim isNegative As Boolean = (TenBytes(9) And (1 << 7)) <> 0
Dim NegVal As Int16 = IIf(isNegative, -1, 1)
Dim expVal As Double = Math.Pow(2, Expo - ExponentBias)
Dim LBits62 As Int16 = Len(CStr(Bits62_0))
Dim mantissa As Double = CDbl("1." & CStr(Bits62_0))
Dim result As Double = NegVal * expVal * mantissa
Return result
End If
End Function
Value -1 converts to -1
Value -0.1 converts to -0.09708764513821
Value -0.01 converts to -0.00983011263306
Value -0.001 converts to -0.00119273528211
Value -0.0001 converts to -0.00009697388128
Value -0.00001 converts to -0.00000981589215
Value -0.000001 converts to -0.00000138095333
Value 1 converts to 1
Value 0.1 converts to 0.09708764513821
Value 0.01 converts to 0.00983011263306
Value 0.001 converts to 0.00119273528211
Value 0.0001 converts to 0.00009697388128
Value 0.00001 converts to 0.00000981589215
Value 0.000001 converts to 0.00000138095333
Value 0.0000001 converts to 0.00000009686278
What am I doing wrong. My values are not close enough. How do I fix this?
The problem is that you treat the fractional part, which represents the fraction of a binary number as a whole number. I changed your function by interpreting the bits 0 to 63 as an integer number which is 263 too big. It's too big by 263 because bit 63 should be bit 0 (instead of 10110101..., we should have 1.0110101..., i.e., the leading 1 has to move 63 positions to the right). I then subtract 63 the the exponent to take this into account. I didn't check the logic related to the flags handling.
Function ConvertLongDouble80(ByVal TenBytes As Byte()) As Double
'https://en.wikipedia.org/wiki/Extended_precision
' 80-bit extended precision format
' --------------------------------
' bit 0 to 63 fraction, bytes 0 to 7
' bit 64 to 78 exponent (bias 16383, bytes 8 to 9)
' bit 79 sign /
'get 15 bit exponent; remove the first bit which is the negative sign
Dim arrExp As Byte() = New Byte() {TenBytes(8), (TenBytes(9) << 1) >> 1}
Dim Expo As UInt16 = BitConverter.ToUInt16(arrExp, 0)
'flag bits
Dim Bit63 As UInt16 = Convert.ToUInt16(TenBytes(7) >> 7)
Dim Bits63_62 As UInt16 = Convert.ToUInt16(TenBytes(7) >> 6)
Dim fraction = BitConverter.ToUInt64(TenBytes, 0) ' 2 ^ 63 too big
If Bit63 = 0 And fraction = 0 Then
Return 0
Else
Const ExponentBias As Integer = 16383
Dim isNegative As Boolean = (TenBytes(9) And (1 << 7)) <> 0
Dim sign = If(isNegative, -1, 1)
Dim expVal As Double = Math.Pow(2, Expo - ExponentBias - 63)
Dim result As Double = sign * expVal * fraction
Return result
End If
End Function
Trying to create a function to simplify ratios (stored as arrays of length 2, with the index 0 being the numerator and index 1 being the denominator). This function gives me an error when the values passed in are object attributes.
Here is the function:
Function SimplifyRatio(Numerator, Denominator)
Dim i As Integer
Dim PNA() As Integer
i = 0
PNA = {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199}
While i < PNA.Length()
If Numerator Mod PNA(i) = 0 And Denominator Mod PNA(i) = 0 Then
Numerator = Numerator / PNA(i)
Denominator = Denominator / PNA(i)
i = 0
End If
i = i + 1
End While
Return {Numerator, Denominator}
End Function
And here is the method containing the erroneous function call:
Public Function CalculateRatio()
Dim ratio(1) As Byte
ratio = SimplifyRatio(Gear.Teeth, Pinion.Teeth)
Return ratio
End Function
Any help would be appreciated,
Yours Sincerely,
KyuSiik
I currently pull data from a database and rank them when i loop through them. Example of such numbers are 45, 45, 67, 99, 34, 65, 88, 22, 90, 90, 90, 23, 55, 46. These are a total of 14 numbers, I want to loop through and assign rank.
Dim i As Integer() = {45, 45, 67, 99, 34, 65, 88, 22, 90, 90, 90, 23, 55, 46}
Dim lastScore As Integer
Dim position As Integer = 0
For Each i1 In i
If Val(lastScore) <> Val(i1) Then
position += 1
Console.WriteLine(position & vbCrLf)
ElseIf Val(lastScore) = Val(i1) Then
Console.WriteLine(position & vbCrLf)
position += 1
End If
lastScore = Val(i1)
Next
The current output of the code above is:
1, 1, 3, 4, 5, 6, 7, 8, 9, 9, 10, 12, 13, 14
Which is wrong. The expected output is supposed to be:
1, 1, 3, 4, 5, 6, 7, 8, 9, 9, 9, 12, 13, 14
How can I achieve this?
Here is an ugly code which creates the expected output:
Dim i As Integer() = {45, 45, 67, 99, 34, 65, 88, 22, 90, 90, 90, 23, 55, 46}
Dim lastScore As Integer
Dim lastScorePosition As Integer
Dim position As Integer = 1
For Each i1 In i
If Val(lastScore) <> Val(i1) Then
Console.Write(position & ",")
lastScorePosition = position
lastScore = Val(i1)
Else
Console.Write(lastScorePosition & ",")
End If
position += 1
Next
The expected result is not correct. I.e. why there is not rank 2?
Simple ranking is achieved with relatively simple code:
Sub Main()
Dim i As Integer() = {45, 45, 67, 99, 34, 65, 88, 22, 90, 90, 90, 23, 55, 46}
Dim lastScore As Integer
Dim position As Integer
Dim sb As New StringBuilder
For Each i1 In i
If Not lastScore = i1 Then position += 1
sb.Append(position & ", ")
lastScore = i1
Next
sb.Remove(sb.Length - 2, 2)
Console.WriteLine(sb.ToString)
Console.ReadLine()
End Sub
The output is:
1, 1, 2, 3, 4, 5, 6, 7, 8, 8, 8, 9, 10, 11
I am trying to write a for loop that goes from 1 to 125 and does the same stuff based off of each number* unless it is 1 of 8 numbers (24, 48, 63, 75, 104, 110, 114, 119) in which case it does nothing. Other than writing an if statement after the for loop that says:
If g <> 24 and g <> 48 and... and g <> 119 Then
Do stuff
End If
Is there a cleaner way to get the code to do what I want?
To make it clearer as to what is happening you could use a Select Case:
Select Case g
Case 24, 48, 63, 75, 104, 110, 114, 119
' do nothing
Case Else
' do stuff
End Select
A Select Case is a nice way to do it
Dim i As Integer
For i = 1 To 125
Select Case i
Case 24, 48, 63, 75, 104, 110, 114, 119
'skip
Case Else
'your code
End Select
Next
You can make a list (array) with the exceptions and check in the for loop if the index is contained in the array and then skip the operation for that index.
pseudo code (c#)
list = new List(){24, 48, 63, 75};
for(int=index; index<=125; index++)
{
if(list.Contains(index))
continue;
// Do some operation
}