ソートすると次のようなデータセットがあります。
Abc0
Abc100
Abv15
Abc4
Abc700
これを次のように並べ替えるにはどうすればよいか考えていました。
Abc0
Abc4
Abc15
Abc100
Abc700
何か案は?
これを試して:
'Return an integer which is greater than zero if the first string is "greater"
'than the second string, less than zero if the first string is "less" than the
'second string, and equal to zero if they are the same string. It is assumed
'that both strings start with alpha characters and end with numeric characters.
Function CompareAlphaNumericStrings(First As String, Second As String) As Integer
Dim arrFirstParts() As String
arrFirstParts = SplitAlphaNumericString(First)
Dim arrSecondParts() As String
arrSecondParts = SplitAlphaNumericString(Second)
Select Case StrComp(arrFirstParts(0), arrSecondParts(0), vbTextCompare)
Case 0
Dim intFirstNumeric As Integer
intFirstNumeric = CInt(arrFirstParts(1))
Dim intSecondNumeric As Integer
intSecondNumeric = CInt(arrSecondParts(1))
If (intFirstNumeric < intSecondNumeric) Then
CompareAlphaNumericStrings = -1
Else
If (intFirstNumeric > intSecondNumeric) Then
CompareAlphaNumericStrings = 1
Else 'they are equal.
CompareAlphaNumericStrings = 0
End If
End If
Case Is < 0
CompareAlphaNumericStrings = -1
Case Is > 0
CompareAlphaNumericStrings = 1
End Select
End Function
'Split the provided string, which is presumably comprised of a set of alpha characters
'followed by a set of numeric characters, and return a two-element array
'containing first the alpha portion and second the numeric portion.
Function SplitAlphaNumericString(ToSplit) As String()
Dim arrReturn(1) As String
For i = 1 To Len(ToSplit)
If (Not IsLetter(Mid(ToSplit, i, 1))) Then
If (i > 1) Then arrReturn(0) = Left(ToSplit, i - 1) Else arrReturn(0) = "" 'If there is any alpha portion at all, grab it, otherwise empty string.
arrReturn(1) = Mid(ToSplit, i) 'The rest should be numeric.
Exit For
End If
Next
SplitAlphaNumericString = arrReturn
End Function
'Return true if the provided string is a single character and that character is a letter (A - Z or a - z).
Function IsLetter(TestChar As String) As Boolean
If Len(TestChar) = 1 Then
If (TestChar >= "A" And TestChar <= "Z") Or _
(TestChar >= "a" And TestChar <= "z") Then
IsLetter = True
Else
IsLetter = False
End If
Else
IsLetter = False
End If
End Function
バブルソートなど、お気に入りのソートアルゴリズムが何であれ、これを使用できます。
Function SortValues()
For i = 1 To 5
For j = 1 To 4
Dim strFirst As String
Dim strSecond As String
strFirst = Sheets(1).Cells(j, 1).Value
strSecond = Sheets(1).Cells(j + 1, 1).Value
'If the first belongs AFTER the second, swap them.
If (CompareAlphaNumericStrings(strFirst, strSecond) > 0) Then
Sheets(1).Cells(j, 1).Value = strSecond
Sheets(1).Cells(j + 1, 1).Value = strFirst
End If
Next
Next
End Function
まず、次の 2 つの UDF を入力します。
Public Function TextPart(sIn As String) As String
Dim L As Long, LL As Long
Dim sCh As String
TextPart = ""
For L = 1 To Len(sIn)
sCh = Mid(sIn, L, 1)
If sCh Like "[a-zA-Z]" Then
TextPart = TextPart & sCh
End If
Next L
End Function
Public Function NumberPart(sIn As String) As Long
Dim L As Long, LL As Long
Dim sCh As String, temp As String
For L = 1 To Len(sIn)
sCh = Mid(sIn, L, 1)
If sCh Like "[a-zA-Z]" Then
Else
temp = temp & sCh
End If
Next L
NumberPart = CLng(temp)
End Function
次に、B1 に次のように入力します。
=textpart(A1) とコピーダウン
次に、C1 に次のように入力します。
=numberpart(A1) とコピーダウン
次に、列 A、B、C を最初に B で並べ替え、次に C で並べ替えます。
君は見るべきだ: