vb.net multi dimensional arrays - vb.net

net right now regarding multi dimensional array my problem is i want to get the nearest numbers for example my input was 13000, the nearest number will be 11667 and then it will subtract it by 13000, then it will multiply by 0.25 and add my 1875.00. here is my code about multidimensional array can you please help me regarding this? i need this in my project thank you in advance
If ComboBox5.Text = "Z" Then
Dim zero(3, 8) As Double
Dim row As Double
Dim col As Double
'col 1
zero(0, 0) = 0.0
zero(1, 0) = 0
zero(2, 0) = 1
'col 2
zero(0, 1) = 0.0
zero(1, 1) = 0.05
zero(2, 1) = 0
'col 3
zero(0, 2) = 41.67
zero(1, 2) = 0.1
zero(2, 2) = 833
'col 4
zero(0, 3) = 208.33
zero(1, 3) = 0.15
zero(2, 3) = 2500
'col 5
zero(0, 4) = 708.33
zero(1, 4) = 0.2
zero(2, 4) = 5833
'col 6
zero(0, 5) = 1875.0
zero(1, 5) = 0.25
zero(2, 5) = 11667
'col 7
zero(0, 6) = 4166.67
zero(1, 6) = 0.3
zero(2, 6) = 20833
'col 8
zero(0, 7) = 10416.67
zero(1, 7) = 0.32
zero(2, 7) = 41667
For row = 0 To 3
For col = 0 To 8
If Val(TextBox18.Text) > Val(zero(row, col)) And Val(TextBox18.Text) < Val(zero(row - 1, col + 1)) Then
ListView1.Items.Add(zero(row, col))
End If
Next
Next
End If

2D array is not very appropriate to store this kind of data, but here is an example to get you started:
Dim data(,) = {
{0.0, 0, 1},
{0.0, 0.05, 0},
{41.67, 0.1, 833},
{208.33, 0.15, 2500},
{708.33, 0.2, 5833},
{1875.0, 0.25, 11667},
{4166.67, 0.3, 20833},
{10416.67, 0.32, 41667}}
Dim value = 13000 ' Dim value = Val(TextBox18.Text)
' data.GetLength(0) is 8, so Enumerable.Range generates the numbers from 0 to 7
Dim range = Enumerable.Range(0, data.GetLength(0))
' .OrderBy orders them by the difference between value and the last column in data
Dim ordered = range.OrderBy(Function(i) Math.Abs(data(i, 2) - value)) ' 5,4,6,3,2,0,1,7
Dim nearestIndex = ordered.First ' 5
Dim value1 = data(nearestIndex, 0) ' 1875.0
Dim value2 = data(nearestIndex, 1) ' 0.25
Dim value3 = data(nearestIndex, 2) ' 11667
Dim result = (value3 - value) * value2 + value1 ' result = 1541.75

Related

Change Number of Categories between Tick-Mark Labels on Chart X-axis

If I have more (or less) data in my Access 2010 graph, I want to decrease (or increase) the number of tick marks on the X-axis. I looked for the right syntax but I couldn't find it.
I did the same for the Y-axis Title and that works fine:
me.Graph1.Object.Axes(2,1).AxisTitles.Caption="g/ml"
For number of tick-marks of the X-axis; I've tried a number of words can not find the right one. It stopped at:
me.Graph.Object.Axes(1,1).Scale.???????? (I want a number of categories = 3 )
Example code from my db for XYScatter chart. xlCategory is for X-axis and xlValue is Y-axis.
this procedure is in a standard module and called by a form and a report
Sub FormatProcGraph(strObject As String, strLabNum As String, booMetric As Boolean, dblOMC, dblMDD)
'format Proctor graph on form and report
Dim obj As Object
Dim gc As Object
Dim intMaxD As Integer
Dim intMinD As Integer
Dim intM As Integer
If strObject Like "Lab*" Then
Set obj = Reports(strObject)
Else
Set obj = Forms(strObject).Controls("ctrProctor").Form
End If
Set gc = obj("gphDensity")
intMaxD = Nz(Int(dblMDD), 0)
intMinD = Nz(Int(DMin("D", "GraphProctor", "Source='Lab' AND LabNum='" & strLabNum & "'")), 0)
With gc
'format y axis scale
If booMetric = True Then
intMaxD = intMaxD + IIf(intMaxD - intMinD < 125, 50, IIf(intMaxD - intMinD < 250, 25, 0))
.Axes(xlValue).MaximumScale = intMaxD
.Axes(xlValue).MinimumScale = intMaxD - 250
.Axes(xlValue).MajorUnit = 50
.Axes(xlValue).MinorUnit = 10
Else
intMaxD = intMaxD + IIf(intMaxD - intMinD < 6, 2, IIf(intMaxD - intMinD < 10, 1, 0))
.Axes(xlValue).MaximumScale = intMaxD
.Axes(xlValue).MinimumScale = intMaxD - 10
.Axes(xlValue).MajorUnit = 2
.Axes(xlValue).MinorUnit = 0.4
End If
'format x axis scale
If Int(dblOMC) > 6 Then
intM = Int(dblOMC) + IIf(dblOMC - Int(dblOMC) >= 0.5, 1, 0)
.Axes(xlCategory).MaximumScale = intM + 7
.Axes(xlCategory).MinimumScale = intM - 5
End If
'y axis label
.Axes(xlValue, xlPrimary).HasTitle = True
If booMetric = True Then
.Axes(xlValue, xlPrimary).AxisTitle.Text = "Dry Density, kg/cu.m"
End If
End With
End Sub
this procedure is behind report
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
'format graphs
Dim MinUWT As Double, MaxUWT As Double
Dim MinDry As Double, MaxDry As Double
Dim MinSoak As Double, MaxSoak As Double
Dim MinRat As Double, MaxRat As Double
With Me
If Not IsNull(!MinOfA) Then
MinUWT = Int(!MinOfU) - IIf(!MaxOfU - !MinOfU <= 2, 3, 1)
MaxUWT = MinUWT + 8
MinDry = Int(!MinOfD / 5) * 5 - (40 - Int((Int(!MaxOfD / 5) * 5 + 5 - Int(!MinOfD / 5) * 5) / 10) * 10) / 2
MaxDry = MinDry + 40
MinSoak = Int(!MinOfS / 5) * 5 - (40 - Int((Int(!MaxOfS / 5) * 5 + 5 - Int(!MinOfS / 5) * 5) / 10) * 10) / 2
MaxSoak = MinSoak + 40
MinRat = Int(!MinOfR / 5) * 5 - (40 - Int((Int(!MaxOfR / 5) * 5 + 5 - Int(!MinOfR / 5) * 5) / 10) * 10) / 2
MaxRat = MinRat + 40
.gphWeight.Axes(xlValue).MinimumScale = MinUWT
.gphWeight.Axes(xlValue).MaximumScale = MaxUWT
.gphITSdry.Axes(xlValue).MinimumScale = MinDry
.gphITSdry.Axes(xlValue).MaximumScale = MaxDry
.gphITSsoak.Axes(xlValue).MinimumScale = MinSoak
.gphITSsoak.Axes(xlValue).MaximumScale = MaxSoak
.gphITSret.Axes(xlValue).MinimumScale = MinRat
.gphITSret.Axes(xlValue).MaximumScale = MaxRat
If Me!Metric = True Then
.gphWeight.Axes(xlValue, xlPrimary).AxisTitle.Text = "Unit Weight, kg/cu.cm"
.gphGradation.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Sieve Size (mm)"
.gphITSdry.Axes(xlValue, xlPrimary).AxisTitle.Text = "ITS Dry, kg/cu.cm"
.gphITSsoak.Axes(xlValue, xlPrimary).AxisTitle.Text = "ITS Soaked, kg/cu.cm"
End If
End If
End With
End Sub

How can I write a code where the values are 'stepped'?

I just started programming in Excel VBA and I have a question.
How can I write a code where the values are 'stepped'?
I want to code this by using do until, do while and for only.
I'm using two variables: x = 1 and y = 1. The value must be the number of the cycle.
The output would look like this:
cells(x,y). value = a
cells(2x,y). value = 2a
cells(2x,2y). value = 3a
cells(3x,2y). value = 4a
cells(3x,3y). value = 5a
cells(4x,3y). value = 6a
cells(4x,4y). value = 7a
This would be an alternative version to do it
Option Explicit
Public Sub Generate()
Dim a As Long: a = 1
Dim i As Long
For i = 1 To 7
Cells((i \ 2) + 1, ((i - 1) \ 2) + 1).Value = i * a
Next i
End Sub
Note that this uses the div Operator 5 \ 2 which is not a standard division 5 / 2. The div operator divides two numbers and returns an integer result.
Standard division of 5 / 2 = 2.5
Div Operator of 5 / 2 = 2
So (i \ 2) + 1, ((i - 1) \ 2) + 1 results in
1, 1
2, 1
2, 2
3, 2
3, 3
4, 3
4, 4
You can step through your sequence in VBA using arrays like so:
Sub StepAXY()
Dim Z As Long, A As Long, X As Long, Y As Long
Dim arrA() As Variant, arrX() As Variant, arrY() As Variant
arrA = Array(1, 2, 3, 4, 5, 6, 7)
arrX = Array(1, 2, 2, 3, 3, 4, 4)
arrY = Array(1, 1, 2, 2, 3, 3, 4)
For Z = 1 To 7 Step 1
A = arrA(Z - 1)
X = arrX(Z - 1)
Y = arrY(Z - 1)
Cells(X * 1, Y * 1) = A * 1
Next Z
End Sub
Here is a different approach. This will give you an extra row (5x,4y) so if this is not desired can be excluded using an If statement.
Sub Generate()
Dim x As Long, y As Long, a As Long, b As Long, c As Long
For b = 1 To 4
Cells(b * x, b * y) = (2 * b - 1) * a
Cells((b + 1) * x, b * y) = 2 * b * a
Next b
End Sub

Change red pixels to blue in a bitmap

I want to change the red pixels to blue. The image is 24 bits .bmp. I am using lockbits because it is faster but the code doesnt find the red pixels!
Code:
Dim bmp As Bitmap = New Bitmap("path")
Dim pos As Integer
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits _
(rect, Drawing.Imaging.ImageLockMode.ReadWrite,
bmp.PixelFormat)
Dim ptr As IntPtr = bmpData.Scan0
Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
Dim rgbValues(bytes - 1) As Byte
Marshal.Copy(ptr, rgbValues, 0, bytes)
For y = 0 To bmp.Height - 1
For x = 0 To bmp.Width - 1
pos = y * bmp.Width * 3 + x * 3
If rgbValues(pos) = 255 And rgbValues(pos + 1) = 0 And rgbValues(pos + 2) = 0 Then
rgbValues(pos + 2) = 255
rgbValues(pos) = 0
End If
Next
Next
Marshal.Copy(rgbValues, 0, ptr, bytes)
bmp.UnlockBits(bmpData)
bmp.Save("new path")
Thank you!
The values that are stored in rgbValues are not in this order
R G B R G B.....
but
B G R B G R.....
so the correct code in your loop is:
' B G R
If rgbValues(pos) = 0 And rgbValues(pos + 1) = 0 And rgbValues(pos + 2) = 255 Then
rgbValues(pos + 2) = 0 'R
rgbValues(pos) = 255 'B
End If

Excel VBA: Variable as First Row of Selection?

I am creating a function in Excel VBA. I am trying to set a variable equal to the first cell in a selection on the worksheet. Basically the equivalent of something like
x = Worksheets("Data").Range("D2").Offset(i - 1, 0)
y = Worksheets("Data").Range("E2").Offset(i - 1, 0)
z = Worksheets("Data").Range("F2").Offset(i - 1, 0)
except I want "Range("D2")" E2 and F2 to instead refer to the first, second and third cell of whatever I've got highlighted on the sheet, rather than a preset cell.
The specific code I've got is:
Function VarunModel(Table As Range, Optional EndCondition As Integer = 0) As Variant
Dim iNumCols As Integer, iNumRows As Integer
Dim i As Integer
Dim SelectedRange As Range
Set SelectedRange = Selection
iNumCols = Table.Columns.Count
iNumRows = Table.Rows.Count
maturity = Worksheets("KMV-Merton").Range("B2").Value
For i = 1 To iNumRows
equity(i) = SelectedRange.Cells(1).Value
debt(i) = SelectedRange.Cells(2).Value
riskFree(i) = Selection.Cells(3).Value
Next i
Dim equityReturn As Variant: ReDim equityReturn(2 To iNumRows)
Dim sigmaEquity As Double
Dim asset() As Double: ReDim asset(1 To iNumRows)
Dim assetReturn As Variant: ReDim assetReturn(2 To iNumRows)
Dim sigmaAsset As Double, meanAsset As Double
Dim x(1 To 1) As Double, n As Integer, prec As Double, precFlag As Boolean, maxDev As Double
For i = 2 To iNumRows: equityReturn(i) = Log(equity(i) / equity(i - 1)): Next i
sigmaEquity = WorksheetFunction.StDev(equityReturn) * Sqr(260)
sigmaAsset = sigmaEquity * equity(iNumRows) / (equity(iNumRows) + debt(iNumRows))
NextItr: sigmaAssetLast = sigmaAsset
For iptr = 1 To iNumRows
x(1) = equity(iptr) + debt(iptr)
n = 1
prec = 0.00000001
Call NewtonRaphson(n, prec, x, precFlag, maxDev)
asset(iptr) = x(1)
Next iptr
For i = 2 To iNumRows: assetReturn(i) = Log(asset(i) / asset(i - 1)): Next i
sigmaAsset = WorksheetFunction.StDev(assetReturn) * Sqr(260)
meanAsset = WorksheetFunction.Average(assetReturn) * 260
If (Abs(sigmaAssetLast - sigmaAsset) > prec) Then GoTo NextItr
Dim disToDef As Double: disToDef = (Log(asset(iNumRows) / debt(iNumRows)) + (meanAsset - sigmaAsset ^ 2 / 2) * maturity) / (sigmaAsset * Sqr(maturity))
Dim defProb As Double: defProb = WorksheetFunction.NormSDist(-disToDef)
VarunModel = defProb
End Function
Thanks.
Try the below code
Dim SelectedRange As Range
Set SelectedRange = Selection
x = SelectedRange.Cells(1).Value
y = SelectedRange.Cells(2).Value
z = SelectedRange.Cells(3).Value
try this:
Dim Row as integer
Dim Col as Integer
Row = 2
Col = 4 'column "D"
x = Worksheets("Data").cells(row, col).Offset(i - 1, 0)
col = col + 1
y = Worksheets("Data").cells(row, col).Offset(i - 1, 0)
col = col + 1
z = Worksheets("Data").cells(row, col).Offset(i - 1, 0)
See the example below for using the selection on the excel, you can control the column you want by changing the column index. If you select only 1 cell, it will also work:
Sub Solution()
x = Selection.Cells(1, 0) 'By using the zero index on the column, it will get the left cell from the selected one.
y = Selection.Cells(2, 0)
Z = Selection.Cells(3, 0)
End Sub

How to make a "key generator" knowing the formula

I have the formula to check 9 integers,
First digit(d1) must be: 1, 2, 5, 6, 8 or 9
Last digit(d9) must be: 0 or 9
9xd1+8xd2+7xd3+6xd4+5xd5+4xd6+3xd7+2xd8+d9 mod 11 = 0
I can "validate" the key, but how can I generate more of this, knowing the conditions for it to be right?
How can I generate 9 different integers from 0 to 9 and check them under this formula?
Thanks for helping!
Generate the first 7 digits randomly, calculating the formula for those digits.
Set the 9th digit's value to 9, and add it to the formula.
Calculate a value for the 8th digit based on the mod of the result of the formula that causes the result of the formula to be mod 11 = 0.
For the exception case where attempting to do this causes mod 11 = 9, set the 9th digit to 0.
Implementation:
Private randGen As New Random()
Function GenNum() As Integer
Dim digits(0 To 8) As Integer
GenNum = 0
Dim checkSum As Integer
digits(0) = randGen.Next(6) + 1
If digits(0) >= 3 Then digits(0) += 2
If digits(0) >= 7 Then digits(0) += 1
checkSum += digits(0) * 9
For d As Integer = 1 To 6
digits(d) = randGen.Next(10)
checkSum += digits(d) * (9 - d)
Next
digits(8) = 9
checkSum += digits(8)
If (checkSum Mod 11) Mod 2 = 1 Then
digits(7) = (11 - (checkSum Mod 11)) \ 2
Else
digits(7) = ((12 - (checkSum Mod 11)) \ 2 + 4) Mod 10
End If
checkSum += digits(7) * 2
If checkSum Mod 11 = 9 Then digits(8) = 0
Dim pow10 As Integer = 1
For d As Integer = 8 To 0 Step -1
GenNum += pow10 * digits(d)
pow10 *= 10
Next
End Function
I can help you to generate integers from 0 to 9.
here is how your form should look like:
and here is the code:
Public Class Form1
Dim NumRandom As Random = New Random
Dim X, Y, Z As Integer
Private Sub GenerateBUT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GenerateBUT.Click
Dim a(9), i, j, RN As Integer
Dim flag As Boolean
flag = False
i = 1
a(j) = 1
Do While i <= 9
Randomize()
RN = CInt(Int(9 * Rnd()) + 1)
For j = 1 To i
If (a(j)) = RN Then
flag = True
Exit For
End If
Next
If flag = True Then
flag = False
Else
a(i) = RN
i = i + 1S
End If
Loop
Label1.Text = a(1)
Label2.Text = a(2)
Label3.Text = a(3)
Label4.Text = a(4)
Label5.Text = a(5)
Label6.Text = a(6)
Label7.Text = a(7)
Label8.Text = a(8)
Label9.Text = a(9)
Z = Label4.Text
Y = Label5.Text
X = Z + Y
X = X - Label3.Text
If X > 1 And X < 10 Then
X = NumRandom.Next(1, 7)
If X = 1 Then
Label1.Text = "0"
ElseIf X = 2 Then
Label2.Text = "0"
ElseIf X = 3 Then
Label3.Text = "0"
ElseIf X = 4 Then
Label4.Text = "0"
ElseIf X = 5 Then
Label5.Text = "0"
ElseIf X = 6 Then
Label6.Text = "0"
ElseIf X = 7 Then
Label7.Text = "0"
End If
End If
End Sub
End Class