Question

所以我在VBA中使用.sort方法来排序一系列日期。在这些日期中混合的是偶尔出现的某些字母。

我需要一种方法在日期之前对这些字母进行排序，并且尚未找到使用.Sort方法的方法。

有什么建议吗？

EX）

1/2/16
4/6/16
2/5/16
B
3/25/16
FV
8/10/16

- 需要看起来像这样 -

B
FV
1/2/16
2/5/16
3/25/16
4/6/16
8/10/16

- 谢谢 -

- 当前代码 -

Dim x As Workbook
Set x = Workbooks("I G T  Ship Balance sheet Template.xlsx")

lrSort = x.Sheets("Template").Range("A500").End(xlUp).Row

x.Sheets("Template").Range("A2:CJ" & lrSort).Sort Key1:=x.Sheets("Template").Range("G2"), Order1:=xlAscending

Answer 1

我们假设您的数据是从A2开始的。您的结果将来自B2

尝试使用以下代码

Sub test()
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Dim Data() As String
    Dim incre As Long
    Dim Datanumeric() As String
    ReDim Data(lastrow - 1)
    ReDim Datanumeric(lastrow - 1)
    For i = 2 To lastrow
        If IsNumeric(Replace(Cells(i, 1), "/", "")) = True Then
            Datanumeric(i - 1) = Cells(i, 1)
        Else
            Data(i - 1) = Cells(i, 1)
        End If
    Next i
    Call sort(Data())
    Call sort(Datanumeric())
    incre = Range("B" & Rows.Count).End(xlUp).Row + 1
    For i = 1 To lastrow - 1
        If Data(i) <> "" Then
            Cells(incre, 2) = Data(i)
            incre = incre + 1
        End If
    Next i
    For i = 1 To lastrow - 1
        If Datanumeric(i) <> "" Then
            Cells(incre, 2) = Datanumeric(i)
            incre = incre + 1
        End If
    Next i
End Sub

Sub sort(list() As String)
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim temp As String
    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If list(i) >= list(j) Then
                temp = list(j)
                list(j) = list(i)
                list(i) = temp
            End If
        Next j
    Next i
End Sub

工作证明

Answer 2

基于新信息编辑：

以下方法使用内置的Excel Custom SortOrder功能根据您的要求进行排序。它仍然使用了许多与我之前提供的相同的辅助代码，但这次它使用Excel来执行排序而不是直接从数组应用。与前面的代码一样，它不必是固定长度列表，但是您必须构建自己的逻辑来测试排序列表的大小。如果您需要帮助，或其他任何问题，请提出具体问题，我们会尽力提供帮助。

Sub TestTheMethod()
    ' Run the SortCustom Method supplying the range in question.
    ' NOTE: Do NOT include the header row.
    ' First arg is the range to sort
    ' Second arg is the key based on which you want to sort (note, the column only matters)

    SortCustom Range("A2:C23"), Range("B1")
End Sub


Sub SortCustom(rInput As Range, rSortField As Range)
    ' First arg is the range to sort WITHOUT headers
    ' Second arg is the sort field (only the column matters)


    Dim nWidth As Long
    Dim nHeight As Long
    Dim vOutput() As Variant
    Dim ws As Worksheet
    Dim rng As Range

    nWidth = rInput.Columns.Count
    nHeight = rInput.Rows.Count

    ReDim vOutput(1 To nHeight, 1 To 1)

    Set rng = Intersect(rInput, rSortField.EntireColumn)
    vOutput = rng

    BubbleSortArrayCustom vOutput, 1

    Set ws = rInput.Parent

    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=rng, _
        CustomOrder:=Join(WorksheetFunction.Transpose(vOutput), ",")

    With ws.Sort
        .SetRange rInput
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Private Sub BubbleSortArrayCustom(vArray() As Variant, nCompIdx As Integer)
    Dim vPlaceHolder As Variant
    Dim nFirst As Long
    Dim nSecond As Long
    Dim i As Long

    For nFirst = LBound(vArray) To UBound(vArray)
        For nSecond = nFirst + 1 To UBound(vArray)
            If CompareTwoValues(vArray(nFirst, nCompIdx), vArray(nSecond, nCompIdx)) Then
                For i = LBound(vArray, 2) To UBound(vArray, 2)
                    vPlaceHolder = vArray(nFirst, i)
                    vArray(nFirst, i) = vArray(nSecond, i)
                    vArray(nSecond, i) = vPlaceHolder
                Next i
            End If
        Next nSecond
    Next nFirst
End Sub

Private Function CompareTwoValues(v1 As Variant, v2 As Variant) As Boolean
    Dim bOutput As Boolean
    Dim sType1 As String
    Dim sType2 As String

    sType1 = TypeName(v1)
    sType2 = TypeName(v2)

    If sType1 = "String" And sType2 = "String" Then
        bOutput = (v1 > v2)
    ElseIf sType1 = "String" And sType2 <> "String" Then
        bOutput = False
    ElseIf sType2 = "String" And sType1 <> "String" Then
        bOutput = True
    Else
        bOutput = (v1 > v2)
    End If

    CompareTwoValues = bOutput
End Function

旧帖子：看一下附带的代码。我已经将其分解为帮助函数，希望能让您更容易理解它并最终修改它以满足您的需求。

代码需要排序范围和要排序的键。然后它使用as数组，自定义比较方法和冒泡排序，对数组进行排序，然后替换原始信息。

尝试复制您的作品，看看它是否符合您的需求。如果您需要更多帮助，请告诉我们。

Sub TestTheMethod()
    ' Run the SortCustom Method supplying the range in question.
    ' NOTE: Do NOT include the header row.
    ' First arg is the range to sort
    ' Second arg is the key based on which you want to sort (note, the column only matters)

    SortCustom Range("A2:C23"), Range("B1")
End Sub


Sub SortCustom(rInput As Range, rSortField As Range)
    ' First arg is the range to sort WITHOUT headers
    ' Second arg is the sort field (only the column matters)


    Dim nWidth As Long
    Dim nHeight As Long
    Dim vOutput() As Variant

    nWidth = rInput.Columns.Count
    nHeight = rInput.Rows.Count

    ReDim vOutput(1 To nHeight, 1 To nWidth)

    vOutput = rInput

    BubbleSortArrayCustom vOutput, (rSortField.Column - rInput.Range("A1").Column + 1)


    rInput = vOutput
End Sub

Private Sub BubbleSortArrayCustom(vArray() As Variant, nCompIdx As Integer)
    Dim vPlaceHolder As Variant
    Dim nFirst As Long
    Dim nSecond As Long
    Dim i As Long

    For nFirst = LBound(vArray) To UBound(vArray)
        For nSecond = nFirst + 1 To UBound(vArray)
            If CompareTwoValues(vArray(nFirst, nCompIdx), vArray(nSecond, nCompIdx)) Then
                For i = LBound(vArray, 2) To UBound(vArray, 2)
                    vPlaceHolder = vArray(nFirst, i)
                    vArray(nFirst, i) = vArray(nSecond, i)
                    vArray(nSecond, i) = vPlaceHolder
                Next i
            End If
        Next nSecond
    Next nFirst
End Sub

Private Function CompareTwoValues(v1 As Variant, v2 As Variant) As Boolean
    Dim bOutput As Boolean
    Dim sType1 As String
    Dim sType2 As String

    sType1 = TypeName(v1)
    sType2 = TypeName(v2)

    If sType1 = "String" And sType2 = "String" Then
        bOutput = (v1 > v2)
    ElseIf sType1 = "String" And sType2 <> "String" Then
        bOutput = False
    ElseIf sType2 = "String" And sType1 <> "String" Then
        bOutput = True
    Else
        bOutput = (v1 > v2)
    End If

    CompareTwoValues = bOutput
End Function

Answer 3

我假设你现在正在排序时，数字出现在开头，字母出现在结尾？如果情况总是如此（并且您的信件不会以数字开头），则无法执行以下操作：

1）按降序排序所有内容，所以现在你的字母出现在开头。

2）然后按升序排序字母，然后按升序排序数字。

您可以通过从排序列表顶部开始工作直到找到一个数字来识别步骤1之后的字母范围。

这会实现你想要的吗？

数字/日期之前的VBA .sort字母

3 个答案: