Поиск пустых ячеек; скопировать соседнюю ячейку в окно сообщения; удалить строку или добавить текст в пустую ячейку - PullRequest
0 голосов
/ 02 июля 2019

Перебрать диапазон столбца D для пустых ячеек. Найдя пустую ячейку, скопируйте текст из соседней ячейки в столбце C в окно сообщения. В окне сообщения можно удалить строку или добавить текст в пустую ячейку. Повторяйте, пока не будет пустых ячеек столбца D.

Ожидается, что удаляются строки, которые содержат бесполезную информацию, и сохраняются строки, которые содержат. Строки, которые содержат полезную информацию, будут вновь классифицированы.

Ответы [ 2 ]

0 голосов
/ 03 июля 2019
Set ws = ActiveSheet
    lastRowCat = 300
    blnks = 300
    For i = 2 To lastRowCat
        If IsEmpty(ws.Cells(i, 4)) Then
            blnks = Range("D2" & ":" & "D" & lastRowCat).SpecialCells(xlCellTypeBlanks).Count
            abc = MsgBox(ws.Cells(i, 3) & " " & "$" & ws.Cells(i, 5), vbYesNo + vbQuestion + vbDefaultButton2, "Save Transaction ?" & " " & blnks & " " & "left")

            If abc = vbYes Then
                cat = Application.InputBox("Add New Category" & " " & ws.Cells(i, 3))
                ws.Cells(i, 4).Value = "(new)" & cat
                lastRowCat = ws.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).row
            Else
                ws.Cells(i, 3).EntireRow.Delete
                lastRowCat = ws.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).row
            End If

        End If

        If i >= lastRowCat Then
            Exit For
        End If

    Next i
0 голосов
/ 03 июля 2019
Dim i As Integer
Dim lastRowCat As Integer
Dim cat As String
Dim ws As Worksheet
Set ws = ActiveSheet

lastRowCat = ws.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).row   'This gives the last Row with a nonempty cell in column A
For i = 2 To lastRowCat
    If IsEmpty(ws.Cells(i, 4)) Then
    abc = MsgBox(ws.Cells(i, 3), vbYesNo + vbQuestion, "Save Transaction")

    If abc = vbYes Then
    cat = Application.InputBox("Add New Category" + " " + ws.Cells(i, 3))
    ws.Cells(i, 4).Value = cat

    Else
    ws.Cells(i, 3).EntireRow.Delete

    End If

    End If
Next i
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...