删除单元格连续出现次数超指定数的行

hy397556

删除数据.rar (8.28 KB, 下载次数: 10)

2025-12-2 16:43 上传

点击文件名下载附件

向各位老大请教，如果用数组删除连续出现次数超出范围的数据，谢谢

cpa_cpv

感觉你的表达，逻辑混乱。可能你自己都不知道要什么条件，要什么结果 。

看着真的费劲。想猜都猜不出来，你要表达的什么。

自己捋一捋吧!

ynzsvt

请检测结果

fgq5910

Sub DeleteRowsBasedOnCondition()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim currentVal As Variant
    Dim count1 As Long, count2 As Long
    Dim maxCount1 As Long, maxCount2 As Long
    Dim deleteRow As Boolean
   
    Set ws = ThisWorkbook.Sheets("Sheet1") '修改为你的工作表名
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
   
    '从最后一行开始向上遍历，避免删除行时索引错乱
    For i = lastRow To 1 Step -1
        deleteRow = False
        maxCount1 = 0
        maxCount2 = 0
        count1 = 0
        count2 = 0
        
        '遍历该行的每一列
        For j = 1 To lastCol
            currentVal = ws.Cells(i, j).Value
            
            '判断当前值是否为1或2
            If currentVal = 1 Then
                count1 = count1 + 1
                count2 = 0 '重置2的计数
                If count1 > maxCount1 Then maxCount1 = count1
            ElseIf currentVal = 2 Then
                count2 = count2 + 1
                count1 = 0 '重置1的计数
                If count2 > maxCount2 Then maxCount2 = count2
            Else
                '遇到其他数值，重置计数
                count1 = 0
                count2 = 0
            End If
        Next j
        
        '检查是否满足删除条件
        If maxCount1 > 2 Or maxCount2 > 3 Then
            deleteRow = True
        End If
        
        '删除行
        If deleteRow Then
            ws.Rows(i).Delete
        End If
    Next i
   
    MsgBox "删除完成！"
End Sub

hy397556

cpa_cpv 发表于 2025-12-2 16:52
感觉你的表达，逻辑混乱。可能你自己都不知道要什么条件，要什么结果 。

看着真的费劲。想猜都猜不出来 ...

老大，指一行数据中，1相邻同为1不能超过2次，2不能超过3,其中一个，超过目标，删除此行

fgq5910

删除单元格连续出现次数超指定数的行

hy397556

ynzsvt 发表于 2025-12-2 17:08
请检测结果

老大，不是两个之各不超过4个，1在一行连续不超过2个，2连续出现在一行不超过3个，

hy397556

fgq5910 发表于 2025-12-2 17:12
删除单元格连续出现次数超指定数的行

太感谢了，我把1与2设置为变量，把判断值也设定为变量就可以了。

fgq5910

删除数据（修改）

fgq5910

Sub DeleteRows()
    Dim i As Long, j As Long, c1 As Long, c2 As Long, m1 As Long, m2 As Long
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Dim lastCol As Long: lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
   
    For i = lastRow To 1 Step -1
        c1 = 0: c2 = 0: m1 = 0: m2 = 0
        For j = 1 To lastCol
            Select Case ws.Cells(i, j).Value
                Case 1: c1 = c1 + 1: c2 = 0: If c1 > m1 Then m1 = c1
                Case 2: c2 = c2 + 1: c1 = 0: If c2 > m2 Then m2 = c2
                Case Else: c1 = 0: c2 = 0
            End Select
        Next
        If m1 > 2 Or m2 > 3 Then ws.Rows(i).Delete
    Next
End Sub