Excel宏 - 删除行,然后重新标记单元格值

时间:2017-08-23 21:34:42

标签: excel vba excel-vba

我尝试做的是删除特定列中的单元格值与要定义的要删除的行匹配的所有行。之后,按组重新排序另一列中的值。

使用以下示例:
我想查看列B并删除任何值为A或C的行。然后我想在A列中的点(。)之后重新编号以重置自己。

宏代码之前图1

Before macro code

删除值A和C后图2

enter image description here

A列重新编号后的最终列表图3 After macro code

我想出了如何使用此代码删除行,但仍坚持下一步做什么:

Sub DeleteRowBasedOnCriteriga()
Dim RowToTest As Long

For RowToTest = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1

    With Cells(RowToTest, 2)
        If .Value = "A" Or .Value = "C" _
        Then _
        Rows(RowToTest).EntireRow.Delete
    End With

Next RowToTest

End Sub

2 个答案:

答案 0 :(得分:1)

这将更容易从上到下循环(使用步骤1而不是步骤-1)。我试图坚持你的原始编码,并做到了这一点:

OnExecute

编辑:我已经更新它以比较反斜杠之前的所有字符串并使用它进行比较。 编辑++:我注意到,当删除行时,最好从下往上工作(步骤-1)以确保每一行都被占用。我已经在第一个代码中重新实现了原始步骤。

答案 1 :(得分:0)

不可否认,这可能不是最有效的,但它应该有效。

Sub DeleteRowBasedOnCriteriga()
Dim RowToTest As Long, i As Long
Application.ScreenUpdating = False
For RowToTest = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
    With Cells(RowToTest, 2)
        If .Value = "A" Or .Value = "C" Then Rows(RowToTest).EntireRow.Delete
    End With
Next RowToTest

Dim totalRows As Long
totalRows = Cells(Rows.Count, 1).End(xlUp).Row
Dim curCelTxt As String, aboveCelTxt As String
For i = totalRows To i Step -1
    If i = 1 Then Exit For
    curCelTxt = Left(Cells(i, 1), WorksheetFunction.Search("\", Cells(i, 1)))
    aboveCelTxt = Left(Cells(i - 1, 1), WorksheetFunction.Search("\", Cells(i - 1, 1)))
    If curCelTxt = aboveCelTxt Then
        Cells(i, 1).Value = ""
    Else
        Cells(i, 1).Value = WorksheetFunction.Substitute(Cells(i, 1), Right(Cells(i, 1), Len(Cells(i, 1)) - WorksheetFunction.Search(".", Cells(i, 1))), "0")
    End If
Next i

Dim rng As Range, cel As Range
Dim tempLastRow As Long
Set rng = Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row)
For Each cel In rng
    If cel.Offset(1, 0).Value = "" Then
        tempLastRow = cel.End(xlDown).Offset(-1, 0).Row
        If tempLastRow = Rows.Count - 1 Then
            tempLastRow = Cells(Rows.Count, 2).End(xlUp).Row
            cel.AutoFill Destination:=Range(cel, Cells(tempLastRow, 1))
            Exit For
        Else
            cel.AutoFill Destination:=Range(cel, Cells(tempLastRow, 1))
        End If
    End If
Next cel
Application.ScreenUpdating = True
End Sub

主要是,我发现您可以使用AutoFill来修复字符串中的最后一个数字。这意味着如果你AutoFill这个文字CAT\Definitions.0向下,你可以在拖动/填充时更新数字。