搜索空细胞;将相邻的单元格复制到消息框;删除行或将文本添加到空单元格中



循环通过一系列为空单元格的列D范围。找到空单元后,将C列中的相邻单元格复制到消息框。消息框给出了删除行或将文本添加到空单元格中的选项。重复直到不存在D列的空单元格。

期望是删除包含无用信息的行并保留所做的行。确实有有用信息的行将被新分类。

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
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

最新更新