如果K列中的值为0，则删除C到K行并将单元格上移 [英] If there is a 0 in column K, delete rows C to K and shift cells up

问题描述

我有一个查看列K的代码，检查是否存在0，是否存在，它将从C到K的对应行删除.

I have a code that looks at Column K, checks if there is a 0 and if there is, it deletes the corresponding rows from C to K.

Sub del()


Application.ScreenUpdating = False 'Prevent screen flickering
Application.Calculation = xlCalculationManual 'Preventing calculation

Dim sh As Worksheet, lr As Long, i As Long, lngStartRow As Long

Set sh = Sheets("Formations_Tracker")
lr = sh.Cells(Rows.Count, "C").End(xlUp).Row
lngStartRow = 2 'Starting data row number.

For i = lr To lngStartRow Step -1
    If sh.Cells(i, "K") = 0 Then
        sh.Cells(i, "K").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "J").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "I").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "H").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "G").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "F").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "E").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "D").Resize(1, 2).Delete Shift:=xlUp
        sh.Cells(i, "C").Resize(1, 2).Delete Shift:=xlUp
    End If
Next i

Set sh = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

问题是，如果最后一行是包含0的行，这是可行的.但是，如果不是最后一行，则似乎正在删除更多行，即使其中没​​有0的行也是如此.

The issue is this works if the last row is the one that contains a 0. However if it's not the last row, it seems to be deleting more rows, even the ones that don't have 0s in them.

推荐答案

您可以将该循环简化为简单的过滤器并删除.请注意，这是删除整行，因此可能需要对端进行一些修改以满足您的需求

You can reduce that loop to a simple filter and delete. Note this is deleting the entire row so this may need some modification on your end to suit your needs

Sub del()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Formations_Tracker")
Dim LR As Long
Dim DeleteMe As Range

LR = ws.Range("K" & ws.Rows.Count).End(xlUp).Row

Application.DisplayAlerts = False

    ws.Range("C1:K" & LR).AutoFilter Field:=9, Criteria1:=0
    Set DeleteMe = ws.Range("C2:K" & LR).SpecialCells(xlCellTypeVisible)
    ws.AutoFilterMode = False
    If Not DeleteMe Is Nothing Then DeleteMe.Delete (xlShiftUp)

Application.DisplayAlerts = True

End Sub

这篇关于如果K列中的值为0，则删除C到K行并将单元格上移的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！