aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

26
Task/Sorting-algorithms-Shell-sort/Visual-Basic/sorting-algorithms-shell-sort.vb Normal file
View file

@ -0,0 +1,26 @@
Sub arrShellSort(ByVal arrData As Variant)
Dim lngHold, lngGap As Long
Dim lngCount, lngMin, lngMax As Long
Dim varItem As Variant
'
lngMin = LBound(arrData)
lngMax = UBound(arrData)
lngGap = lngMin
Do While (lngGap < lngMax)
lngGap = 3 * lngGap + 1
Loop
Do While (lngGap > 1)
lngGap = lngGap \ 3
For lngCount = lngGap + lngMin To lngMax
varItem = arrData(lngCount)
lngHold = lngCount
Do While ((arrData(lngHold - lngGap) > varItem))
arrData(lngHold) = arrData(lngHold - lngGap)
lngHold = lngHold - lngGap
If (lngHold < lngMin + lngGap) Then Exit Do
Loop
arrData(lngHold) = varItem
Next
Loop
arrShellSort = arrData
End Sub'