Сортировка массива с украинскими буквами

[Danver]

Нужно отсортировать массив с текстовыми данными. Дело в том что строки начинающиеся с буквы "є" "і" "ї" ставит в самый верх!

сортирую методом пузырька

Sub BubbleSort(pstrArray() As String)
    plngMaxItem = UBound(pstrArray)
    Dim i As Long
    Dim fSwitched As Boolean
    Dim strTemp As String
    Dim strTemp2 As String
    Do
        fSwitched = False
        For i = 1 To plngMaxItem - 1
             If pstrArray(i, 1) > pstrArray(i + 1, 1) Then
                 fSwitched = True
                strTemp = pstrArray(i, 1)
                strTemp2 = pstrArray(i, 2)
                pstrArray(i, 1) = pstrArray(i + 1, 1)
                pstrArray(i, 2) = pstrArray(i + 1, 2)
                pstrArray(i + 1, 1) = strTemp
                pstrArray(i + 1, 2) = strTemp2
            End If
        Next
    Loop While fSwitched
End Sub

может кто знает, как обойти эту проблему? В листбоксе то сортирует нормально, но мне надо отсортировать без отображения формы, так сказать в "тихом" режиме...

может можно как-то поменять кодировку в VB?

[Hugo121]

Может сперва с помощью Replace получить две временные переменные и сравнивать их? Но конечно будет тормозить... т.е. замедлит код.

[Danver]

Вообщем я нашел решение... не совсем то, что хотел, но результат устраивает. Правда сортировка замедляет скрипт на пару секунд при сортировке файла с 560 адресатами

Function UkrToRus(Letter As String) ' функция заменяет украинские буквы на русские
    If Letter <> "" Then ' если не пустая строка
        If Letter = "Є" Or Letter = "є" Or Letter = "І" Or Letter = "і" Or Letter = "Ї" Or Letter = "ї" Or Letter = "Ґ" Or Letter = "ґ" Then ' если это одна из укр букв
            UkrToRus = Switch(Letter = "Є", "Е", Letter = "є", "е", Letter = "І", "И", Letter = "і", "и", Letter = "Ї", "И", Letter = "ї", "и", Letter = "Ґ", "Г", Letter = "ґ", "г") ' заменяем ее
        Else ' если нет
            UkrToRus = Letter ' то оставляем все как есть
        End If
    'Else
        'UkrToRus = ""
    End If
End Function

Sub BubbleSort(pstrArray() As String) ' доработанный, правильно сортирует строки начинающиеся с украинских букв
    plngMaxItem = UBound(pstrArray)
    Dim i As Long
    Dim fSwitched As Boolean
    Dim strTemp As String
    Dim strTemp2 As String
    Dim el1$, el2$, el1_code%, el2_code%
    Do
        fSwitched = False
        For i = 1 To plngMaxItem - 1
            el1 = Mid(pstrArray(i, 1), 1, 1)
            el2 = Mid(pstrArray(i + 1, 1), 1, 1)
            LetCur = 1 ' это счетчик букв в строке
ReSort:
            'сортируем по возрастанию
            If el1 = "" Then el1_code = 1000 Else el1_code = Asc(UkrToRus(el1)) ' это защита от пустых строк... чтобы они всегда были в конце списка
            If el2 = "" Then el2_code = 1000 Else el2_code = Asc(UkrToRus(el2)) ' это защита от пустых строк... чтобы они всегда были в конце списка
            If el1_code > el2_code Then
                'сортируем по убыванию
                ' If pstrArray(i) < pstrArray(i + 1) Then
                fSwitched = True
                strTemp = pstrArray(i, 1)
                strTemp2 = pstrArray(i, 2) ' массив двумерный, вторая часть сортируется в зависимости от сортировки первой;)
                pstrArray(i, 1) = pstrArray(i + 1, 1)
                pstrArray(i, 2) = pstrArray(i + 1, 2) ' массив двумерный, вторая часть сортируется в зависимости от сортировки первой;)
                pstrArray(i + 1, 1) = strTemp
                pstrArray(i + 1, 2) = strTemp2 ' массив двумерный, вторая часть сортируется в зависимости от сортировки первой;)
            Else
                If el1_code = el2_code Then ' если символы одинаковые, то ...
                    If LetCur <= Len(pstrArray(i, 1)) Then ' и мы в пределах длины строки..
                        LetCur = LetCur + 1 ' смотрим на следующий символ
                        el1 = Mid(pstrArray(i, 1), LetCur, 1)
                        el2 = Mid(pstrArray(i + 1, 1), LetCur, 1)
                        GoTo ReSort ' и сравниваем снова
                    End If
                End If
            End If
        Next
    Loop While fSwitched
End Sub

Доработал слегка Пузырек, теперь он при сортировке принимает во внимание не только первую букву строки, а все буквы

[Hugo121]

Я думал так:

Sub BubbleSort(pstrArray() As String)
    plngMaxItem = UBound(pstrArray)
    Dim i As Long
    Dim fSwitched As Boolean
    Dim strTemp As String
    Dim strTemp2 As String
    Dim tt1 As String, tt2 As String
    Do
        fSwitched = False
        For i = 1 To plngMaxItem - 1
                
        tt1 = pstrArray(i, 1)
        tt2 = pstrArray(i + 1, 1)
        tt1 = Replace(tt1, "Є", "Е")
        tt1 = Replace(tt1, "є", "е")
        tt1 = Replace(tt1, "І", "И")
        tt1 = Replace(tt1, "і", "и")
        tt1 = Replace(tt1, "Ї", "И")
        tt1 = Replace(tt1, "ї", "и")
        tt1 = Replace(tt1, "Ґ", "Г")
        tt1 = Replace(tt1, "ґ", "г")
        tt2 = Replace(tt2, "Є", "Е")
        tt2 = Replace(tt2, "є", "е")
        tt2 = Replace(tt2, "І", "И")
        tt2 = Replace(tt2, "і", "и")
        tt2 = Replace(tt2, "Ї", "И")
        tt2 = Replace(tt2, "ї", "и")
        tt2 = Replace(tt2, "Ґ", "Г")
        tt2 = Replace(tt2, "ґ", "г")
       
             If tt1 > tt2 Then
                 fSwitched = True
                strTemp = pstrArray(i, 1)
                strTemp2 = pstrArray(i, 2)
                pstrArray(i, 1) = pstrArray(i + 1, 1)
                pstrArray(i, 2) = pstrArray(i + 1, 2)
                pstrArray(i + 1, 1) = strTemp
                pstrArray(i + 1, 2) = strTemp2
            End If
        Next
    Loop While fSwitched
End Sub

И вообще, если регистр не важен, то число замен можно в 2 раза сократить.

[Danver]

если я не ошибаюсь, то в зависимости от регистра меняется числовой код символа...

очень замедляет выполнение скрипта, та часть которая выполняется если буквы одинаковые Видимо придется смирится.

В любом случае, спасибо вам за помощь!!!

[Hugo121]

Насчёт регистра я думал так - если Вам не важно, и для сравнения всё равно, ёжик или Ёжик, то

tt1 = ucase(pstrArray(i, 1))
tt2 = ucase(pstrArray(i + 1, 1))

Далее меняем только заглавные.
Как это будет сортироваться - не знаю, вероятно правильно, но ничего не мешает Вам проверить.