Удаление пустых строк, а затем добавление строки до значения столбца

Question

Я новичок здесь, и у меня мозг около недели, чтобы попытаться понять это. Я также искал везде, и каждый пример, который я пытаюсь исправить, не работает. Итак, я прошу прощения, если это где-то здесь, но не смог найти его.

My delema, У меня есть компьютерная электронная таблица, которая создает более 2000 строк в Excel. Половина пустых пустых строк. Моя цель состоит в том, чтобы удалить все пустые строки, а затем вставить строки раньше, если столбец «n» имеет значение Y или N.

У меня есть удаление пустых строк, но я пытаюсь добавить строки на основе по значению. Любая помощь будет оценена по достоинству.

---

Sub DeleteBlankRows() 
    Dim Rng As Range 
    Dim WorkRng As Range 

    On Error Resume Next 
    xTitleId = "KutoolsforExcel" 

    Set WorkRng = Application.Selection 
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) 

    xRows = WorkRng.Rows.Count 
    Application.ScreenUpdating = False 

    For i = xRows To 1 Step -1 
    If Application.WorksheetFunction.CountA(WorkRng.Rows(i)) = 0 Then 
     WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp 
    End If 
    Next 

    Application.ScreenUpdating = True 
End Sub 

---

Sub InsertRow() 
    If ActiveCell = "y" Then 
    Selection.EntireRow.Insert 
    If ActiveCell = "n" Then 
     Selection.EntireRow.Insert 
    End If 
    End If 
End Sub 

Answer 1

Объедините логику вашей первой подпрограммы со вторым (код не тестировался)

Sub DeleteBlankRows() 

    Const COLUMN_TO_CHECK_FOR_Y_N = 10& 

    Dim Rng As Range 
    Dim WorkRng As Range 

    On Error Resume Next 
    xTitleId = "KutoolsforExcel" 

    Set WorkRng = Application.Selection 
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) 

    xRows = WorkRng.Rows.Count 
    Application.ScreenUpdating = False 

    ' Delete Rows 
    For i = xRows To 1 Step -1 
    If Application.WorksheetFunction.CountA(WorkRng.Rows(i)) = 0 Then 
     WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp 
    End If 
    Next 

    ' Add Rows 
    For i = xRows To 1 Step -1 
    If WorkRng.Cells(i, COLUMN_TO_CHECK_FOR_Y_N) = "N" Then 
     WorkRng.Rows(i).Insert 
    End If 
    Next 

    Application.ScreenUpdating = True 
End Sub 

Обратите внимание, что вы должны остаться в стороне от выбора и ActiveCell. См. this answer.