खोज…
परिचय
.NET फ्रेमवर्क के विपरीत, एप्लिकेशन लाइब्रेरी के लिए Visual Basic में सरणियों को सॉर्ट करने के लिए रूटीन शामिल नहीं है।
दो प्रकार के वर्कअराउंड हैं: 1) अन्य सामान्य रूप से उपलब्ध पुस्तकालयों में छंटाई दिनचर्या का उपयोग करते हुए, खरोंच से छँटाई एल्गोरिदम को लागू करना, या 2)।
एल्गोरिथम कार्यान्वयन - एक आयामी आयाम पर त्वरित क्रमबद्ध
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray((inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
एक्सेल लाइब्रेरी का उपयोग एक आयामी आयाम को सॉर्ट करने के लिए
यह कोड Microsoft Excel ऑब्जेक्ट लाइब्रेरी में Sort
क्लास का लाभ उठाता है।
आगे पढ़ने के लिए, देखें:
Sub testExcelSort()
Dim arr As Variant
InitArray arr
ExcelSort arr
End Sub
Private Sub InitArray(arr As Variant)
Const size = 10
ReDim arr(size)
Dim i As Integer
' Add descending numbers to the array to start
For i = 0 To size
arr(i) = size - i
Next i
End Sub
Private Sub ExcelSort(arr As Variant)
' Ininitialize the Excel objects (required)
Dim xl As New Excel.Application
Dim wbk As Workbook
Set wbk = xl.Workbooks.Add
Dim sht As Worksheet
Set sht = wbk.ActiveSheet
' Copy the array to the Range object
Dim rng As Range
Set rng = sht.Range("A1")
Set rng = rng.Resize(UBound(arr, 1), 1)
rng.Value = xl.WorksheetFunction.Transpose(arr)
' Run the worksheet's sort routine on the Range
Dim MySort As Sort
Set MySort = sht.Sort
With MySort
.SortFields.Clear
.SortFields.Add rng, xlSortOnValues, xlAscending, xlSortNormal
.SetRange rng
.Header = xlNo
.Apply
End With
' Copy the results back to the array
CopyRangeToArray rng, arr
' Clear the objects
Set rng = Nothing
wbk.Close False
xl.Quit
End Sub
Private Sub CopyRangeToArray(rng As Range, arr)
Dim i As Long
Dim c As Range
' Can't just set the array to Range.value (adds a dimension)
For Each c In rng.Cells
arr(i) = c.Value
i = i + 1
Next c
End Sub
Modified text is an extract of the original Stack Overflow Documentation
के तहत लाइसेंस प्राप्त है CC BY-SA 3.0
से संबद्ध नहीं है Stack Overflow