DenSyo
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору mrdime набросал бегло функцию сравнения двух строк. функция возвращает номер большего аргумента, либо 0 в случае равенства. добавил обработку точки и знака минус Код: Function CompareNaturale(ByVal str1 As String, ByVal str2 As String) As Integer Dim i, k, k1, k2 As Long Dim s1(), s2(), dsep As String Dim v1, v2 As Variant Dim nn As Boolean If str1 = str2 Then CompareNaturale = 0 Else If str1 Like "*#*" And str2 Like "*#*" Then dsep = Application.International(xlDecimalSeparator) k1 = 1 ReDim Preserve s1(0 To k1) If IsNumeric(Left(str1, 1)) Then nn = True Else nn = False For i = 1 To Len(str1) If IsNumeric(Mid(str1, i, 1)) Then If Not nn Then k1 = k1 + 1 ReDim Preserve s1(0 To k1) nn = True If LTrim(Right(s1(k1 - 1), 2)) = "-" And Not (IsNumeric(s1(k1 - 2)) And Len(s1(k1 - 1)) = 1) Then s1(k1 - 1) = Left(s1(k1 - 1), Len(s1(k1 - 1)) - 1) s1(k1) = "-" End If End If Else If nn Then k1 = k1 + 1 ReDim Preserve s1(0 To k1) nn = False End If End If s1(k1) = s1(k1) & Mid(str1, i, 1) Next i k2 = 1 ReDim Preserve s2(0 To k2) If IsNumeric(Left(str2, 1)) Then nn = True Else nn = False For i = 1 To Len(str2) If IsNumeric(Mid(str2, i, 1)) Then If Not nn Then k2 = k2 + 1 ReDim Preserve s2(0 To k2) nn = True If LTrim(Right(s2(k2 - 1), 2)) = "-" And Not (IsNumeric(s2(k2 - 2)) And Len(s2(k2 - 1)) = 1) Then s2(k2 - 1) = Left(s2(k2 - 1), Len(s2(k2 - 1)) - 1) s2(k2) = "-" End If End If Else If nn Then k2 = k2 + 1 ReDim Preserve s2(0 To k2) nn = False End If End If s2(k2) = s2(k2) & Mid(str2, i, 1) Next i k = IIf(k1 < k2, k1, k2) For i = 1 To k If s1(i) <> s2(i) Then If IsNumeric(s1(i)) And IsNumeric(s2(i)) Then v1 = CLng(s1(i)) v2 = CLng(s2(i)) If i > 1 Then If Replace(Trim(s1(i - 1)), ".", dsep) = dsep Then v1 = CDbl("0" & dsep & s1(i)) If i > 2 Then If IsNumeric(s1(i - 2)) Then If CLng(s1(i - 2)) < 0 Then v1 = 0 - v1 End If If Replace(Trim(s2(i - 1)), ".", dsep) = dsep Then v2 = CDbl("0" & dsep & s2(i)) If i > 2 Then If IsNumeric(s2(i - 2)) Then If CLng(s2(i - 2)) < 0 Then v2 = 0 - v2 End If End If If v1 <> v2 Then If v1 > v2 Then CompareNaturale = 1 Else CompareNaturale = 2 Else If s1(i) > s2(i) Then CompareNaturale = 1 Else CompareNaturale = 2 End If Else If s1(i) > s2(i) Then CompareNaturale = 1 Else CompareNaturale = 2 End If Exit For Else If i = k Then If k1 = k2 Then CompareNaturale = 0 Else If k1 > k2 Then CompareNaturale = 1 Else CompareNaturale = 2 End If End If Next i Else If str1 > str2 Then CompareNaturale = 1 Else CompareNaturale = 2 End If End If End Function | | Всего записей: 219 | Зарегистр. 19-01-2008 | Отправлено: 06:02 29-11-2017 | Исправлено: DenSyo, 10:36 01-12-2017 |
|