VBA排序的问题

贺达勇

贺达勇

怎么同时发了两个，是我点的太快了。。。。。。。

贺达勇

Sub 排序数据()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim sortRange As Range
    Dim hasExpired As Boolean
   
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 将"Sheet1"替换为你的工作表名称
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取最后一行的行号
   
    ' 定义数据区范围
    Set dataRange = ws.Range("A2:J" & lastRow)
   
    ' 根据J列的天数进行排序
    dataRange.Sort Key1:=ws.Range("J2:J" & lastRow), Order1:=xlAscending, Header:=xlNo
   
    ' 检查是否存在"已到期"或"已结束"的数据
    For Each cell In dataRange.Columns("J").Cells
        If cell.Value = "已到期" Or cell.Value = "已结束" Then
            hasExpired = True
            Exit For
        End If
    Next cell
   
    ' 如果没有"已到期"和"已结束"的数据，则重新排序整个数据区
    If Not hasExpired Then
        dataRange.Sort Key1:=ws.Range("J2:J" & lastRow), Order1:=xlAscending, Header:=xlNo
    Else
        ' 查找"已过期"或"已结束"的数据
        Set sortRange = dataRange.SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow
        
        ' 将"已过期"或"已结束"的数据移动到后面列
        sortRange.Cut
        ws.Cells(lastRow + 1, 1).PasteSpecial xlPasteValues
        
        ' 清空剪切板
        Application.CutCopyMode = False
        
        ' 重新排序整个数据区
        dataRange.Sort Key1:=ws.Range("J2:J" & lastRow), Order1:=xlAscending, Header:=xlNo
    End If
End Sub            这个代码不行。

吴中泉

截图看着不是很好的吗？
是从小到大排列的呀

吴中泉

贺达勇 发表于 2023-5-20 12:36
怎么同时发了两个，是我点的太快了。。。。。。。

贺达勇

吴中泉 发表于 2023-5-20 14:10

是的，谢谢。

贺达勇

吴中泉 发表于 2023-5-20 14:10

我上传的文件中有正确的排序

吴中泉

贺达勇 发表于 2023-5-20 14:29
我上传的文件中有正确的排序

我弄好了，效果如图，你测试一下

吴中泉

吴中泉

这是附件，请下载测试，代码在模块2
自动排序代码不对.rar (22.9 KB, 下载次数: 3)

2023-5-20 14:56 上传

点击文件名下载附件