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 |
|
Всего записей: 218 | Зарегистр. 19-01-2008 | Отправлено: 06:02 29-11-2017 | Исправлено: DenSyo, 10:36 01-12-2017 |
|
