Excel 筛选行一起引用列中的值

我有这个密码。。它工作正常，但我需要将K列中值为“closed”的行移动到具有相同文本的最后一行之后，同时在向列添加“x”时，如果应该移动到值为“x”的最后一行之后。 有什么建议吗

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
Dim rw As Long

Application.EnableEvents = False
Application.ScreenUpdating = False

With ActiveSheet
rw = Target.Row

If rw = 2 Then
      'Do nothing
Else
    If Not Intersect(Target, Range("K:K")) Is Nothing And LCase(Target) = "closed" Or LCase(Target) = "x" Then
    Target.EntireRow.Select
    Selection.Cut
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("K" & Cells(Rows.Count, "K").End(xlUp).Row).Select
End If
End If
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

---

你没有回答我的澄清问题

请测试下一个代码，该代码假设您需要剪切写入“closed”或“x”的行（列K:K），并将其复制到最后一个此类现有记录（“closed”或“x”）之后：

---

“工作正常”应该是什么意思？它运行时不会引发错误？“文本相同的最后一行”应该是什么意思？K:K列上的“闭合”或“x”？如果一切正常，你需要我们提供什么样的帮助？要使其粘贴到与最后一个空行不同的位置？当前，当添加“closed”或“x”时，该行将移动到第二行的上一行，但需要“closed”才能移动到最后一行之后，列单元格为“closed”且与“x”相同。如果是这样，您是否测试了我发布的代码？这不是你所需要的吗？是的，正是我所需要的，谢谢。很高兴知道我们在这里，当有人花一些时间来解决我们的问题并给出解决问题的答案时，勾选左侧代码侧复选框，以使其成为可接受的答案。这样，其他搜索类似问题的人就会知道代码是有效的……我遇到了一个小问题，就是第一次在列中添加（“Closed”或“x”）时出错。该守则是否有任何修订建议？thks@dola我不明白你说什么，对不起。。。当你谈论一个错误时，你必须提到错误描述和它出现的代码行。理论上，它不应该在意这些字符串是否出现，不管它是第一次还是第二次出现。。。如果没有任何

strCrit

存在，代码应处理该问题并退出Sub。对不起，您是对的；我忘了说我做了一些更改，将行从第二行向上移动到最后一行：我在函数中将xlPrevious更改为xlNext，同时删除（rngF.offset（1）.EntireRow.Insert xlUp）中的偏移量（1）。真的，抱歉，您以前的代码是完美的，也许我在更改中犯了一个错误，使行从下向上移动。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.cells.count > 1 Then Exit Sub
 Dim rw As Long

 rw = Target.row

 If rw = 2 Then
      'Do nothing
 Else
    Dim rngF As Range
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        If LCase(Target) = "closed" Or LCase(Target) = "x" Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            Set rngF = FindUp(Target.Value, Range("K:K"))
            If rngF Is Nothing Then Application.EnableEvents = True: Exit Sub
            rngF.Offset(1).EntireRow.Insert xlUp
        End If
    End If
 End If
 Application.EnableEvents = True
End Sub

Function FindUp(strCrit As String, rng As Range) As Range
 Dim celF As Range
 Set celF = rng.Find(What:=strCrit, After:=rng.cells(1.1), SearchDirection:=xlPrevious)
 If Not celF Is Nothing Then Set FindUp = celF
End Function