Excelmacros – 删除行，然后重新标记单元格值

我想要做的是删除任何特定列中的单元格值与所定义的要删除的行匹配。 之后，按组重新排列另一列中的值。

使用下面的例子：
我想查看列B并删除任何具有A或C值的行。然后，我想基本重新编号在A列中的点（。）之后进行重置。

macros代码之前图1

值A和C去掉后（图2）

列A后的最后一个列表重新编号图3

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

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 

Answer 1

这将更容易从上到下循环（使用步骤1而不是步骤-1）。 我试图保持真实的原始编码，并做到这一点：

 Sub DeleteRowBasedOnCriteriga() Dim RowToTest As Long Dim startRow As Long Dim i As Integer startRow = 2 'Clear the rows that have "A" or "C" in column B For RowToTest = Cells(Rows.Count, 1).End(xlUp).Row to startRow To Step -1 With Cells(RowToTest, 2) If .Value = "A" Or .Value = "C" _ Then _ Rows(RowToTest).EntireRow.Delete End With Next RowToTest 'If the left 3 characters of the cell above it are the same,_ 'then increment the renumbering scheme For RowToTest = startRow To Cells(Rows.Count, 1).End(xlUp).Row If Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), "\")) = Left(Cells(RowToTest, 1).Offset(-1, 0).Value, InStr(1, Cells(RowToTest, 1), "\")) Then i = i + 1 Cells(RowToTest, 1).Value = Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), ".")) & i Else i = 0 Cells(RowToTest, 1).Value = Left(Cells(RowToTest, 1).Value, InStr(1, Cells(RowToTest, 1), ".")) & i End If Next RowToTest End Sub 

编辑：我已经更新它比较反斜杠之前的所有string，并使用该比较。 编辑+ +：我已经注意到，删除行时，最好从下往上（步骤-1），以确保每一行都占了。 我已经重新实现了第一个代码中的原始步骤。

Answer 2

诚然，这可能不是最有效的，但它应该工作。

 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来修复string中的最后一个数字。 这意味着如果您AutoFill此文本， CAT\Definitions.0下，您可以在拖/填时获取数字更新。