Vba excel сортировка массива по возрастанию - Word и Excel

Сортировка одномерного массива в VBA Excel по возрастанию или убыванию с числовым или текстовым сравнением числовых элементов. Сортировка выбором.

Сортировка массива выбором

Функция, осуществляющая сортировку выбором одномерного массива по возрастанию с числовым сравнением числовых элементов массива:

Function SortArray(myArray As Variant) As Variant

Dim l As Long, u As Long, i1 As Long, i2 As Long, im As Long, tmp As Variant

‘Определение наименьшего индекса массива

l = LBound(myArray)

‘Определение наибольшего индекса массива

u = UBound(myArray)

For i1 = l To u

im = i1

For i2 = i1 To u

‘Поиск наименьшего элемента массива, начиная с элемента myArray(i1)

If myArray(i2) < myArray(im) Then im = i2

‘Если наименьший элемент не является текущим (im <> i1),

‘тогда наименьший элемент и текущий меняются местами

If im <> i1 Then

tmp = myArray(i1)

myArray(i1) = myArray(im)

myArray(im) = tmp

End If

SortArray = myArray

End Function

Внешний цикл сравнивает по очереди каждый элемент массива с наименьшем элементом, найденным вложенным циклом среди оставшихся элементов (с бóльшими индексами), и, если наименьший элемент myArray(im) не является текущим элементом myArray(i1), они меняются местами.

Функция с выбором вида сортировки

Функция сортировки одномерного массива с дополнительным параметром mySort, который позволяет выбрать сортировку по возрастанию или убыванию и с числовым или текстовым сравнением числовых элементов массива:

Function SortArrayNew(myArray As Variant, mySort As Long) As Variant

Dim l As Long, u As Long, i1 As Long, i2 As Long, im As Long, tmp As Variant

l = LBound(myArray)

u = UBound(myArray)

For i1 = l To u

im = i1

For i2 = i1 To u

Select Case mySort

Case Is = 0

If myArray(i2) < myArray(im) Then im = i2

Case Is = 1

If CStr(myArray(i2)) < CStr(myArray(im)) Then im = i2

Case Is = 2

If myArray(i2) > myArray(im) Then im = i2

Case Is = 3

If CStr(myArray(i2)) > CStr(myArray(im)) Then im = i2

End Select

If im <> i1 Then

tmp = myArray(i1)

myArray(i1) = myArray(im)

myArray(im) = tmp

End If

SortArrayNew = myArray

End Function

Значения, которые может принимать параметр mySort:

Значение	Вид сортировки
0	по возрастанию с числовым сравнением чисел
1	по возрастанию с текстовым сравнением чисел
2	по убыванию с числовым сравнением чисел
3	по убыванию с текстовым сравнением чисел

Пример сортировки массива

Пример использования разных видов сортировки одномерного массива в VBA Excel с выводом результатов на рабочий лист:

Sub Primer()

Dim myArr As Variant, x As Variant, i As Long, n As Long

For i = 1 To 4

myArr = Array(46, 25, «Лето», 508, 35, «лес», 11, 5, «25ф», «Лес», 45, 58, «лето», 350)

myArr = SortArrayNew(myArr, i — 1)

n = 1

For Each x In myArr

Cells(n, i) = myArr(n — 1)

n = n + 1

End Sub

Результаты разных видов сортировки массива myArr:

Источник

You didn’t want an Excel-based solution but since I had the same problem today and wanted to test using other Office Applications functions I wrote the function below.

Limitations:

2-dimensional arrays;
maximum of 3 columns as sort keys;
depends on Excel;

Tested calling Excel 2010 from Visio 2010

Option Base 1


Private Function sort_array_2D_excel(array_2D, array_sortkeys, Optional array_sortorders, Optional tag_header As String = "Guess", Optional tag_matchcase As String = "False")

'   Dependencies: Excel; Tools > References > Microsoft Excel [Version] Object Library

    Dim excel_application As Excel.Application
    Dim excel_workbook As Excel.Workbook
    Dim excel_worksheet As Excel.Worksheet

    Set excel_application = CreateObject("Excel.Application")

    excel_application.Visible = True
    excel_application.ScreenUpdating = False
    excel_application.WindowState = xlNormal

    Set excel_workbook = excel_application.Workbooks.Add
    excel_workbook.Activate

    Set excel_worksheet = excel_workbook.Worksheets.Add
    excel_worksheet.Activate
    excel_worksheet.Visible = xlSheetVisible

    Dim excel_range As Excel.Range
    Set excel_range = excel_worksheet.Range("A1").Resize(UBound(array_2D, 1) - LBound(array_2D, 1) + 1, UBound(array_2D, 2) - LBound(array_2D, 2) + 1)
    excel_range = array_2D


    For i_sortkey = LBound(array_sortkeys) To UBound(array_sortkeys)

        If IsNumeric(array_sortkeys(i_sortkey)) Then
            sortkey_range = Chr(array_sortkeys(i_sortkey) + 65 - 1) & "1"
            Set array_sortkeys(i_sortkey) = excel_worksheet.Range(sortkey_range)

        Else
            MsgBox "Error in sortkey parameter:" & vbLf & "array_sortkeys(" & i_sortkey & ") = " & array_sortkeys(i_sortkey) & vbLf & "Terminating..."
            End

        End If

    Next i_sortkey


    For i_sortorder = LBound(array_sortorders) To UBound(array_sortorders)
        Select Case LCase(array_sortorders(i_sortorder))
            Case "asc"
                array_sortorders(i_sortorder) = XlSortOrder.xlAscending
            Case "desc"
                array_sortorders(i_sortorder) = XlSortOrder.xlDescending
            Case Else
                array_sortorders(i_sortorder) = XlSortOrder.xlAscending
        End Select
    Next i_sortorder

    Select Case LCase(tag_header)
        Case "yes"
            tag_header = Excel.xlYes
        Case "no"
            tag_header = Excel.xlNo
        Case "guess"
            tag_header = Excel.xlGuess
        Case Else
            tag_header = Excel.xlGuess
    End Select

    Select Case LCase(tag_matchcase)
        Case "true"
            tag_matchcase = True
        Case "false"
            tag_matchcase = False
        Case Else
            tag_matchcase = False
    End Select


    Select Case (UBound(array_sortkeys) - LBound(array_sortkeys) + 1)
        Case 1
            Call excel_range.Sort(Key1:=array_sortkeys(1), Order1:=array_sortorders(1), Header:=tag_header, MatchCase:=tag_matchcase)
        Case 2
            Call excel_range.Sort(Key1:=array_sortkeys(1), Order1:=array_sortorders(1), Key2:=array_sortkeys(2), Order2:=array_sortorders(2), Header:=tag_header, MatchCase:=tag_matchcase)
        Case 3
            Call excel_range.Sort(Key1:=array_sortkeys(1), Order1:=array_sortorders(1), Key2:=array_sortkeys(2), Order2:=array_sortorders(2), Key3:=array_sortkeys(3), Order3:=array_sortorders(3), Header:=tag_header, MatchCase:=tag_matchcase)
        Case Else
            MsgBox "Error in sortkey parameter:" & vbLf & "Maximum number of sort columns is 3!" & vbLf & "Currently passed: " & (UBound(array_sortkeys) - LBound(array_sortkeys) + 1)
            End
    End Select


    For i_row = 1 To excel_range.Rows.Count

        For i_column = 1 To excel_range.Columns.Count

            array_2D(i_row, i_column) = excel_range(i_row, i_column)

        Next i_column

    Next i_row


    excel_workbook.Close False
    excel_application.Quit

    Set excel_worksheet = Nothing
    Set excel_workbook = Nothing
    Set excel_application = Nothing


    sort_array_2D_excel = array_2D


End Function

This is an example on how to test the function:

Private Sub test_sort()

    array_unsorted = dim_sort_array()

    Call msgbox_array(array_unsorted)

    array_sorted = sort_array_2D_excel(array_unsorted, Array(2, 1, 3), Array("desc", "", "asdas"), "yes", "False")

    Call msgbox_array(array_sorted)

End Sub


Private Function dim_sort_array()

    Dim array_unsorted(1 To 5, 1 To 3) As String

    i_row = 0

    i_row = i_row + 1
    array_unsorted(i_row, 1) = "Column1": array_unsorted(i_row, 2) = "Column2": array_unsorted(i_row, 3) = "Column3"

    i_row = i_row + 1
    array_unsorted(i_row, 1) = "OR": array_unsorted(i_row, 2) = "A": array_unsorted(i_row, 3) = array_unsorted(i_row, 1) & "_" & array_unsorted(i_row, 2)

    i_row = i_row + 1
    array_unsorted(i_row, 1) = "XOR": array_unsorted(i_row, 2) = "A": array_unsorted(i_row, 3) = array_unsorted(i_row, 1) & "_" & array_unsorted(i_row, 2)

    i_row = i_row + 1
    array_unsorted(i_row, 1) = "NOT": array_unsorted(i_row, 2) = "B": array_unsorted(i_row, 3) = array_unsorted(i_row, 1) & "_" & array_unsorted(i_row, 2)

    i_row = i_row + 1
    array_unsorted(i_row, 1) = "AND": array_unsorted(i_row, 2) = "A": array_unsorted(i_row, 3) = array_unsorted(i_row, 1) & "_" & array_unsorted(i_row, 2)

    dim_sort_array = array_unsorted

End Function


Sub msgbox_array(array_2D, Optional string_info As String = "2D array content:")

    msgbox_string = string_info & vbLf

    For i_row = LBound(array_2D, 1) To UBound(array_2D, 1)

        msgbox_string = msgbox_string & vbLf & i_row & vbTab

        For i_column = LBound(array_2D, 2) To UBound(array_2D, 2)

            msgbox_string = msgbox_string & array_2D(i_row, i_column) & vbTab

        Next i_column

    Next i_row

    MsgBox msgbox_string

End Sub

If anybody tests this using other versions of office please post here if there are any problems.

Источник

Home / VBA / Arrays / VBA Sort Array

To sort an array in VBA, you need to write a code where you can match the first element of the array with the next one and inter-change them if the first one needs to come before. You need a FOR LOOP (For Next) for this and the UCASE function.

In this tutorial, we will see both ways (A-Z and Z-A) to sort elements of an array.

Sort an Array (A-Z)

In the below code, you have an array with five elements, and these elements have values starting from E to A, and now we need to sort in A-Z order.

Steps to Sort an Array

First, you need to write a nested loop with For Next using the upper and lower bounds of the array.
After that, within that loop, you need to use the VBA IF Statement to compare the two elements.
From here, if the first element needs to come before the next element you need to interchange them saving their values in variables.
In the end, use the “Next” keyword to close the loop.

Option Base 1
Sub vba_sort_array_a_to_z()

Dim myArray() As Variant
ReDim myArray(5)
Dim i As Integer
Dim j As Integer
Dim Temp As String

myArray(1) = "E"
myArray(2) = "D"
myArray(3) = "C"
myArray(4) = "B"
myArray(5) = "A"

'sorting array from A to Z
For i = LBound(myArray) To UBound(myArray)
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

Debug.Print myArray(1)
Debug.Print myArray(2)
Debug.Print myArray(3)
Debug.Print myArray(4)
Debug.Print myArray(5)

End Sub

Make sure to activate the Immediate Window to see the result there.

Sort an Array (Z-A)

In the same way, you can sort from Z-A. In the earlier method, we compared the first element with the next element in the sequence, but in this code, you need to do the opposite. So if the second (next in sequence) element is greater than the first one the code will interchange them.

Option Base 1
Sub vba_sort_array_z_to_a()

Dim myArray() As Variant
ReDim myArray(5)
Dim i As Integer
Dim j As Integer
Dim Temp As String

myArray(1) = "A"
myArray(2) = "B"
myArray(3) = "C"
myArray(4) = "D"
myArray(5) = "E"

'sorting array from A to Z
For i = LBound(myArray) To UBound(myArray)
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) < UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

Debug.Print myArray(1)
Debug.Print myArray(2)
Debug.Print myArray(3)
Debug.Print myArray(4)
Debug.Print myArray(5)

End Sub

Источник

Return to VBA Code Examples

This tutorial will demonstrate how to Sort values in an Array in VBA

Sorting a One-Dimensional Array using a loop

Sorting an Array requires a bit of data manipulation using loops, variables and temporary arrays.

You first need to populate the array with your values
You then need to loop through the array twice! Once to get a value from the current element array, and the while still in that loop, to get the value of the next element in the array.
You then need to compare the elements – and move the 2nd one to the position of the first one if the 2nd one is alphabetically BEFORE the 1st one.

The example below demonstrates this procedure.

Sub SortAnArray()
   Dim i As Long
'Set the array
   Dim strName() As Variant
   Dim Temp As Variant
'populate the array
   strName() = Array("Bob Smith", "John Davies", "Fred Jones", "Steve Jenkins", "Bob Williams")
'loop through bound of the arry and get the first name
   For i = LBound(strName) To UBound(strName) - 1
'loop through again, and check if the next name is alphabetically before or after the original
      For j = i + 1 To UBound(strName)
         If UCase(strName(i)) > UCase(strName(j)) Then
'if the name needs to be moved before the previous name, add to a temp array
            Temp = strName(j)
'swop the names
            strName(j) = strName(i)
            strName(i) = Temp
         End If
     Next j
   Next i
'Output the Array through a message box
   MsgBox Join(strName(), vbCrLf)
End Sub

If you run this procedure, you would get the following message box.

You can also sort the array in the other direction – eg: Z to A by changing this line of code

If UCase(strName(i)) > UCase(strName(j)) Then

to this line of code

If UCase(strName(i)) < UCase(strName(j)) Then

You would then get the following message box.

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

Learn More!

Источник

Get our FREE VBA eBook of the 30 most useful Excel VBA macros.

Automate Excel so that you can save time and stop doing the jobs a trained monkey could do.

Claim your free eBook

At some point in your VBA life it will be necessary to display or re-order an array/list alphabetically (or reverse alphabetically). Unfortunately, VBA doesn’t have a function for sorting arrays automatically, but with a little bit of coding we can create a reusable function which would achieve something similar.

Setting up the example

This first VBA code is to set the scene. It creates an array, calls the function to sort the array and then outputs the sorted array. You only need this first piece of code if you are following it through as an example.

Sub RunTheSortMacro()

Dim i As Long
Dim myArray As Variant

'Set the array
myArray = Array("p", "A", "G", 3, "l", "6", 10, "K", 7)

'myArray variable set to the result of SortArrayAtoZ function
myArray = SortArrayAtoZ(myArray)

'Output the Array through a message box
For i = LBound(myArray) To UBound(myArray)
    MsgBox myArray(i)
Next i

End Sub

Sort the array A-Z

I like to use a Function, rather than a Sub for sorting an array. The function is a reusable piece of code, it can form part of your ‘Core’ module, which you can copy into any VBA project. This function takes an array as its variable and outputs the same array sorted in alphabetical order.

Function SortArrayAtoZ(myArray As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array A-Z
For i = LBound(myArray) To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortArrayAtoZ = myArray

End Function

Sort the array Z-A

The reverse function to sort the array Z-A

Function SortArrayZtoA(myArray As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array Z-A
For i = LBound(myArray) To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) < UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortArrayZtoA = myArray

End Function

About the author

Hey, I’m Mark, and I run Excel Off The Grid.

My parents tell me that at the age of 7 I declared I was going to become a qualified accountant. I was either psychic or had no imagination, as that is exactly what happened. However, it wasn’t until I was 35 that my journey really began.

In 2015, I started a new job, for which I was regularly working after 10pm. As a result, I rarely saw my children during the week. So, I started searching for the secrets to automating Excel. I discovered that by building a small number of simple tools, I could combine them together in different ways to automate nearly all my regular tasks. This meant I could work less hours (and I got pay raises!). Today, I teach these techniques to other professionals in our training program so they too can spend less time at work (and more time with their children and doing the things they love).

Do you need help adapting this post to your needs?

I’m guessing the examples in this post don’t exactly match your situation. We all use Excel differently, so it’s impossible to write a post that will meet everybody’s needs. By taking the time to understand the techniques and principles in this post (and elsewhere on this site), you should be able to adapt it to your needs.

But, if you’re still struggling you should:

Read other blogs, or watch YouTube videos on the same topic. You will benefit much more by discovering your own solutions.
Ask the ‘Excel Ninja’ in your office. It’s amazing what things other people know.
Ask a question in a forum like Mr Excel, or the Microsoft Answers Community. Remember, the people on these forums are generally giving their time for free. So take care to craft your question, make sure it’s clear and concise. List all the things you’ve tried, and provide screenshots, code segments and example workbooks.
Use Excel Rescue, who are my consultancy partner. They help by providing solutions to smaller Excel problems.

What next?
Don’t go yet, there is plenty more to learn on Excel Off The Grid. Check out the latest posts:

Источник