求教一个如何实现表格的N次排序功能的VBA

zouxu1120

各位大佬，小白请教一个VBA咋做啊，实现表格的N次排序功能。


针对“北京”部分。
第一次排序，对B列：
1、带有项目编号的放在前面
2、不带项目编号的放在后面。


第二次排序，对I列：
1）B列带项目号的行
1、单元格里有文字内容的，排在前面
2、单元格里是日期的排在中间，按照日期升序排列
3、单元格里是空的，排在最后

2）B列不带项目号的行
1、单元格里有文字内容的，排在前面
2、单元格里是日期的排在中间，按照日期升序排列
3、单元格里是空的，排在最后



原始：



操作效果：




最终效果：

123.rar (58 KB, 下载次数: 7)

2024-4-29 16:57 上传

点击文件名下载附件

zouxu1120

用chatgpt做了一个，但是只能搞定第一次排序。


Sub 一按项目号排序() ' 带项目号的放在前面，不带项目号的放在后面，但是没有排序
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim oneRow As Long
    Dim twoRow As Long
    Dim sortRange As Range
    Dim cell As Range
    Dim moveRow As Long
    Dim j As Long
   
    ' 设置要操作的工作表
    Set ws = ThisWorkbook.Sheets("周报")
   
    ' 获取最后一行的行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    startRow = 0
    endRow = 0
    oneRow = 0
    twoRow = 0
    moveRow = 0
   
    ' 遍历数据
    For i = 2 To lastRow
        If ws.Cells(i, 1).Value = "一" Then
            oneRow = i
            startRow = i + 1
        ElseIf ws.Cells(i, 1).Value = "二" Then
            twoRow = i
            endRow = i - 1
        End If
        
        ' 找到"一"和"二"之间的数据行后进行处理
        If startRow > 0 And endRow > 0 Then
            ' 对"一"和"二"之间的数据行进行排序
            Set sortRange = ws.Range(ws.Cells(startRow, 1), ws.Cells(endRow, 16))
            sortRange.Sort key1:=ws.Range("A" & startRow), order1:=xlAscending, Header:=xlNo
            
            ' 将包含"-"的行移动到"一"下方，不包含"-"的行移动到最后一个包含"-"的行的下方
            For Each cell In sortRange.Columns(2).Cells
                If InStr(cell.Value, "-") > 0 Then
                    If moveRow = 0 Then
                        moveRow = oneRow + 1
                    End If
                    ws.Rows(cell.Row).Cut Destination:=ws.Rows(moveRow)
                    moveRow = moveRow + 1
                End If
            Next cell
            
            moveRow = 0
            For j = sortRange.Rows.Count To 1 Step -1
                If InStr(ws.Cells(sortRange.Cells(j, 2).Row, 2).Value, "-") > 0 Then
                    moveRow = ws.Cells(sortRange.Cells(j, 2).Row, 2).Row + 1
                    Exit For
                End If
            Next j
            
            For Each cell In sortRange.Columns(2).Cells
                If InStr(cell.Value, "-") = 0 Then
                    ws.Rows(cell.Row).Cut Destination:=ws.Rows(moveRow)
                    moveRow = moveRow + 1
                End If
            Next cell
            
            Exit For
        End If
    Next i
        
End Sub

zouxu1120

第二次排序一直没有搞定。

lcluck2002

项目编号与其他的文字如何区分？项目编号如果是文字呢？其他的文字若也是在数字开头呢？

grf1973

可以预处理一下，根据不同情况在B列加上abcd，排序后再恢复。

grf1973

比如，有项目编号前加A，文字加B，空格加C

zouxu1120

lcluck2002 发表于 2024-4-29 17:18
项目编号与其他的文字如何区分？项目编号如果是文字呢？其他的文字若也是在数字开头呢？

只区分带项目编号和不带编号，也就是区分是否带“-”来处理

zouxu1120

已经搞定了。还是采用辅助列排序。针对B列，辅助列设置成1.2。第一次排序；针对I列，辅助列设置1.2.3.4.5.6.第二次排序。