I have an array dat that shows Type = Variant/Variant(0 to 500, 0 to 0, 0 to 1)
There is a "column" of dates:
dat(0, 0, 0) = #1/1/2013#
dat(1, 0, 0) = #1/2/2013#
I want to extract this set of dates. I tried:
Dim dat As Variant
Dim dt As Variant
'stuff gets dat in the format described above
dt = Application.Index(dat, 0, 1, 1)
Unfortunately this gives me an Error 13 Type Mismatch. What am I doing wrong?
Use a Loop
Sub dural()
Dim dat(0 To 500, 0 To 1, 0 To 1) As Variant
dat(0, 0, 0) = #1/1/2013#
dat(1, 0, 0) = #1/2/2013#
Dim dt(0 To 500) As Variant
For i = 0 To 500
dt(i) = dat(i, 0, 0)
Next i
End Sub
Related
As shown in the code, I get CustomLabels displayed, but they are not on the MajorTickMarks defined in the ChartArea. How do I get this in sync?
vb.net
Dim from_X, to_X As Date
from_X = myClass.get_DateOfWeek(CInt(yearkNo), CInt(weekNo), DayOfWeek.Monday)
'Last week from mainTable
weekNo = mainTable.Columns(mainTable.Columns.Count - 1).ColumnName.Split(CChar("/"))(0).Substring(2, 2)
yearkNo = mainTable.Columns(mainTable.Columns.Count - 1).ColumnName.Split(CChar("/"))(1).Substring(0, 4)
to_X = myClass.get_DateOfWeek(CInt(yearkNo), CInt(weekNo), DayOfWeek.Saturday)
Dim ints as integer = CInt(DateDiff(DateInterval.WeekOfYear, from_X, to_X, FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFullWeek))
Dim xdate(ints) As Date 'is looped through and the date of the respective week is added.
newchart(chart1) 'create new chart
Dim chartArea1 As New ChartArea("Default")
chart1.ChartAreas.Add(chartArea1)
chart1.ChartAreas("Default").AxisX.IntervalType = DateTimeIntervalType.Weeks
chart1.ChartAreas("Default").AxisX.Interval = 1
chart1.ChartAreas("Default").AxisX.LabelAutoFitStyle = LabelAutoFitStyles.DecreaseFont
chart1.ChartAreas("Default").AxisX.LabelAutoFitMinFontSize = 7
chart1.ChartAreas("Default").AxisX.LabelStyle.Font = My.Settings.fontbold8
chart1.ChartAreas("Default").AxisX.LabelStyle.Angle = 90
chart1.ChartAreas("Default").AxisX.MajorTickMark.Enabled = True
chart1.ChartAreas("Default").AxisX.MinorTickMark.Enabled = False
chart1.ChartAreas("Default").AxisX.Minimum = from_X.ToOADate()'44443
chart1.ChartAreas("Default").AxisX.Maximum = to_X.ToOADate()'44828
chart1.ChartAreas("Default").AxisX.IsMarginVisible = False
chart1.Series.Add("K").Color = ColorTranslator.FromHtml("#297AB7") 'MattBlau colorx(0)
chart1.Series("K").Points.DataBindXY(xdate, yValues)
chart1.ChartAreas("Default").AxisX.CustomLabels.Clear()
For intVal As Integer = 0 To ints - 1
Debug.Print(intVal & " - " & Format(xdate(intVal), "yyyy-MM-dd"))
Select Case intVal
Case 0, 5, 10, 15, 20, ints - 2
chart1.ChartAreas("Default").AxisX.CustomLabels.Add(xdate(intVal).ToOADate(), xdate(ints - 1).ToOADate(), myClass.get_WeekNumber(xdate(intVal)) & "/" & xdate(intVal).Year)
End Select
Next
It looks now like here in the picture:
https://www.spearhead-home.com/Downloads/20220517_XAchseKWs.jpg
Found now a solution for me:
AxisX.IntervalType, AxisX.Minimum, AxisX.Maximum must match the series DataBindXY(xValues, yValues)
Dim ints as integer = CInt(DateDiff(DateInterval.WeekOfYear, von_X, bis_X, _
FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFullWeek))
Dim xdate(ints) As Date 'is looped through and the date of the respective week is added.
Dim xInt(ints) As Integer 'is looped through and the numbers of the interval-count added.
chart1.ChartAreas("Default").AxisX.IntervalType = DateTimeIntervalType.NotSet
chart1.ChartAreas("Default").AxisX.Interval = 1
chart1.ChartAreas("Default").AxisX.Minimum = 0
chart1.ChartAreas("Default").AxisX.Maximum = ints - 1
chart1.ChartAreas("Default").AxisX.CustomLabels.Clear()
For intVal As Integer = 0 To ints - 1
Dim kw_run As String = ""
kw_run = myClass.set_WeekFormat(myClass.get_WeekNumber(xdate(intVal)), xdate( _
intVal), True)
'result looks like: 2022/20
chart1.ChartAreas("Default").AxisX.CustomLabels.Add(intVal, intVal + 1, kw_run, _
0, LabelMarkStyle.None)
Next
'Series
chart1.Series("mySeries").Points.DataBindXY(xInt, yValues)
'...
Not sure how to output the numbers, once they are in ascending order.
This is the task in the pseudocode that I am trying to move into VB.
Dim a() = {2,3,1,4}
Dim swapped = False
Output the values of a()
Do Swapped 🡨 False
For I = 1 to end of the array Compare a(i-1) with a(i) if they are not in ascending order pass them to swapped (from task 1)
Swapped(a(i-1),a(i)) assign the returned value to the
variable swapped.
While swapped = True
Output the values of a()
Dim num = New Integer() {2, 3, 1, 4}
Dim swapped As Boolean = False
While swapped = False
For i = 1 To 4
If num(i - 1) > num(i) Then
temp = num(i)
num(i) = num(i - 1)
num(i - 1) = temp
swapped = True
Else
swapped = False
End If
Next
End While
While swapped = True
Console.WriteLine(num)
End While
Console.ReadLine()
Here you go:
For Each n As Integer In num
Console.WriteLine(n.ToString)
Next
Btw there's a problem with your swapping algorithm: if they are already in the right you will enter an infinite loop, and if there's a swap on the last number you'll exit the loop even if they are not in the right order. If it puzzles you let me a comment and we'll sort this out.
Although, #laancelot showed you how to output the array, I thought I would show you a simple way to sort an array.
Private Sub OrderArray()
Dim num As Integer() = {2, 3, 1, 4}
Array.Sort(num)
Console.WriteLine("Ascending")
For Each i In num
Console.WriteLine(i.ToString)
Next
'If you want it the other way around
Array.Reverse(num)
Console.WriteLine("Descending")
For Each i In num
Console.WriteLine(i.ToString)
Next
Console.ReadLine()
End Sub
If you don't want to use vb net generic array order method, and you prefer use the swap concept, here you can try:
Private Sub TestOrderSwap()
Dim num = New Integer() {9, 7, 0, 11, 12, 10, 6, 2, 3, 1, 4}
If OrderSwap(num, "ASC") Then
For a = 0 To num.Length - 1
Debug.Print(num(a))
Next
End If
If OrderSwap(num, "DESC") Then
For a = 0 To num.Length - 1
Debug.Print(num(a))
Next
End If
End Sub
Private Function OrderSwap(ByRef myArray As Integer(), OrderType As String) As Boolean
Dim swp As Integer = 0
Dim swpFlg As Boolean = False
For a = 1 To myArray.Length - 1
swp = myArray(a)
For b = 0 To a - 1
If (myArray(b) > swp And OrderType = "ASC") Or (myArray(b) < swp And OrderType = "DESC") Then
For c = a - 1 To b Step -1
myArray(c + 1) = myArray(c)
Next
myArray(b) = swp
swpFlg = True
Exit For
End If
Next
Next
Return swpFlg
End Function
This is kinda complicated for me to understand
Dim test() As Byte = New Byte() {50, 40, 30, 10, 10}
Dim answer() As UInteger = SortLexicoGraphicallyArrayMappedFile(test)
The answer is the each Rotation sorted from lowest array value to highest array value.
Rotation 0 = 50, 40, 30, 10, 10
Rotation 1 = 10, 50, 40, 30, 10
Rotation 2 = 10, 10, 50, 40, 30
Rotation 3 = 30, 10, 10, 50, 40
Rotation 4 = 40, 30, 10, 10, 50
When I sort this array above by hand I should get
Rotation 2 = 10, 10, 50, 40, 30
Rotation 1 = 10, 50, 40, 30, 10
Rotation 3 = 30, 10, 10, 50, 40
Rotation 4 = 40, 30, 10, 10, 50
Rotation 0 = 50, 40, 30, 10, 10
So the answer should be 2, 1, 3, 4, 0
I get stuck in a infinite loop and I can't put my finger on it
My Previous question works because the data is always static here I try to move all the data around all over the place which is probably why it gets stuck I can't figure out a workaround around that.. i need to move all the data around to save cpu time later that's why I didn't pick the answer from the page below.
How to order array in lexicographical order vb.net
Here is my Code
Public Function GetRotation(Data As Byte(), rotation As UInteger) As Byte()
'Rotation Left
Dim rotationData As New List(Of Byte)
Dim start As UInteger = Data.Length - rotation Mod Data.Length
For i = 0 To Data.Length - 1
rotationData.Add(Data((start + i) Mod (Data.Length)))
Next
Return rotationData.ToArray()
End Function
Public Function SortLexicoGraphicallyArrayMappedFile(ByRef data As Byte()) As UInteger()
Dim OrderedRotations As New List(Of UInteger)
Dim rotatedData As Byte()
Dim rotation As UInteger = 0
Dim mmF As MemoryMappedFile
mmF = MemoryMappedFile.CreateFromFile(My.Application.Info.DirectoryPath & "\outFile", FileMode.CreateNew, "test", CLng(data.LongLength * data.LongLength))
Dim mmVA As MemoryMappedViewAccessor
mmVA = mmF.CreateViewAccessor(0, data.LongLength * data.LongLength)
Dim pos As Long = 0
For rotation = 0 To data.Length - 1
rotatedData = GetRotation(data, rotation)
mmVA.WriteArray(Of Byte)(pos, rotatedData, 0, rotatedData.Length)
pos += rotatedData.Length
Next
For rotation = 0 To data.Length - 1
OrderedRotations.Add(rotation)
Next
Dim eachRotation As Integer = 0
Dim data1() As Byte
ReDim data1(data.Length - 1)
Dim data2() As Byte
ReDim data2(data.Length - 1)
Dim index As Long
For rotation = 0 To data.Length - 1
Dim flag As Boolean
Do
flag = False
For eachRotation = OrderedRotations.Count - 1 To 0 Step -1
mmVA.ReadArray(Of Byte)((OrderedRotations(rotation) * data.Length), data1, 0, data.Length)
If OrderedRotations(eachRotation) = OrderedRotations(rotation) Then Continue For
mmVA.ReadArray(Of Byte)((OrderedRotations(eachRotation) * data.Length), data2, 0, data.Length)
For index = 0 To data.Length - 1
If data1(index) > data2(index) Then
Exit For
ElseIf data1(index) < data2(index) Then
mmVA.WriteArray(Of Byte)((OrderedRotations(eachRotation) * data.Length), data1, 0, data1.Length)
mmVA.WriteArray(Of Byte)((OrderedRotations(rotation) * data.Length), data2, 0, data2.Length)
Dim tmpFirst As UInteger = OrderedRotations(rotation)
OrderedRotations(rotation) = OrderedRotations(eachRotation)
OrderedRotations(eachRotation) = tmpFirst
flag = True
Exit For
End If
Next
Next
Loop While flag
Next
Return OrderedRotations.ToArray()
End Function
I don't know if this is right but I fixed it for you.
Public Function SortLexicoGraphicallyArrayMappedFile(ByRef data As Byte()) As UInteger()
Dim OrderedRotations As New List(Of UInteger)
Dim rotatedData As Byte()
Dim rotation As UInteger = 0
Dim mmF As MemoryMappedFile
mmF = MemoryMappedFile.CreateFromFile(My.Application.Info.DirectoryPath & "\outFile296", FileMode.CreateNew, "test", CLng(data.LongLength * data.LongLength))
Dim mmVA As MemoryMappedViewAccessor
mmVA = mmF.CreateViewAccessor(0, data.LongLength * data.LongLength)
Dim pos As Long = 0
For rotation = 0 To data.Length - 1
rotatedData = GetRotation(data, rotation)
mmVA.WriteArray(Of Byte)(pos, rotatedData, 0, rotatedData.Length)
pos += rotatedData.Length
Next
For rotation = 0 To data.Length - 1
OrderedRotations.Add(rotation)
Next
Dim eachRotation As Integer = 0
Dim data1() As Byte
ReDim data1(data.Length - 1)
Dim data2() As Byte
ReDim data2(data.Length - 1)
Dim index As Long
For rotation = 0 To data.Length - 1
Dim flag As Boolean
Do
flag = False
For eachRotation = OrderedRotations.Count - 1 To 0 Step -1
If rotation = eachRotation Then Exit For
mmVA.ReadArray(Of Byte)(rotation * data.Length, data1, 0, data.Length)
mmVA.ReadArray(Of Byte)((eachRotation * data.Length), data2, 0, data.Length)
For index = 0 To data.Length - 1
If data1(index) < data2(index) Then
Exit For
ElseIf data1(index) > data2(index) Then
mmVA.WriteArray(Of Byte)((eachRotation * data.Length), data1, 0, data1.Length)
mmVA.WriteArray(Of Byte)((rotation * data.Length), data2, 0, data2.Length)
Dim tmpFirst As UInteger = OrderedRotations(eachRotation)
OrderedRotations(eachRotation) = OrderedRotations(rotation)
OrderedRotations(rotation) = tmpFirst
flag = True
Exit For
End If
Next
Next
Loop While flag
Next
Return OrderedRotations.ToArray()
End Function
Is there a plugin that helps generate letters (A-Z) in excel as seen below? Or can we write some sort of VBA script to do this?
Stackoverflow is not a code-for-me service. Anyhow, the task looked interesting, and I have decided to code something about it:
Option Explicit
Public Sub WriteLetterA()
Dim varLetterA(8) As Variant
Dim lngColCounter As Long
Dim lngRowCounter As Long
Dim blnReverse As Boolean
Dim rngCell As Range
blnReverse = True
varLetterA(0) = Array(1, 1, 1, 0, 0, 1, 1, 1)
varLetterA(1) = Array(1, 0, 0, 0, 0, 0, 0, 1)
varLetterA(2) = Array(1, 0, 0, 1, 1, 0, 0, 1)
varLetterA(3) = Array(1, 0, 0, 1, 1, 0, 0, 1)
varLetterA(4) = Array(0, 0, 0, 1, 1, 0, 0, 0)
varLetterA(5) = Array(0, 0, 0, 0, 0, 0, 0, 0)
varLetterA(6) = Array(0, 0, 0, 0, 0, 0, 0, 0)
varLetterA(7) = Array(0, 0, 1, 1, 1, 1, 0, 0)
varLetterA(8) = Array(0, 0, 1, 1, 1, 1, 0, 0)
Cells(1, 1).Select
For lngRowCounter = 0 To UBound(varLetterA)
For lngColCounter = 0 To UBound(varLetterA(lngRowCounter))
Set rngCell = Cells(lngRowCounter + 1, lngColCounter + 1)
If varLetterA(lngRowCounter)(lngColCounter) Then
rngCell.Interior.Color = IIf(blnReverse, vbBlack, vbWhite)
Else
rngCell.Interior.Color = IIf(blnReverse, vbWhite, vbBlack)
End If
Next lngColCounter
Next lngRowCounter
End Sub
' Points for improvement - varLetterA in a separate class
' Refer to the sheet, do not assume it
' Pass the first cell as a reference
This is what you get:
blnReverse = False
blnReverse = True
Take a look at the points for improvement - they can be useful, if you decide to build the rest of the alphabet. Good luck.
for i = 0 to array.length
if array(i) = 2 and array (i+1) = 3 and .. and .. .. then
do xx on array (i+20)
..
..
end if
next
i need to check an array for a specific combination of numbers before i perform an operation, and i need to know the start point of the array as well. does anybody know how i can remove repetition because it's kind of hard to read when you have so many conditions?
array will be typically something like 02 0101 0000 so i need to check 10 consecutive values before i perform any operation
Dim j As Integer = 0
Dim b() = {1, 1}
Dim tempFlg As Boolean = False
Dim a() As Integer = {0, 2, 0, 1, 0, 1, 0, 0, 0, 0}
For i As Integer = 0 To a.Length - 1
If a(i) = b(0) Then
For j = 1 To b.Length - 1
If a(i + j) = b(j) Then
tempFlg = True
End If
Next
End If
Next
If tempFlg = True Then
MsgBox("Item present")
End If