首页 > 解决方案 > 在其他地方输入相同数据时删除旧条目?

问题描述

我有一张工作表,上面有 190 个名字和人们坐的桌子。

当我在新的座位上写下相同的名字时,我想自动搜索一个人以前坐过的位置并删除旧座位上的名字。

Option Explicit

Public Sub One_Find()
    Dim Placeholder As Integer
    Dim FieldRange As Range
    Set FieldRange = Cells.Find(What:=ActiveCell.Value, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByColumns)
    Placeholder = 0

    If FieldRange Is Nothing Then
        MsgBox ("Find failed")
        Exit Sub
    End If

    Dim FirstAddress As String
    FirstAddress = FieldRange.Address

    Do While FieldRange.Address = FirstAddress
        FieldRange = Cells.FindNext(FieldRange)
        Placeholder = Placeholder + 1
        If Placeholder = 2000 Then
            Exit Sub
        End If
    Loop

    FieldRange.Value = "WORKS"
End Sub

也许一个解决方案:

Option Explicit

Public Sub One_Find()
    Dim Placeholder As Integer
    Dim FieldRange As Range
    Dim Placeholder2 As String
    Placeholder2 = ActiveCell.Value
    Set FieldRange = Cells.Find(What:=Placeholder2, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByColumns)
    Placeholder = 0

    If FieldRange Is Nothing Then
        MsgBox ("Find failed")
        Exit Sub
    End If

    Dim FirstAddress As String
    FirstAddress = FieldRange.Address

    Do While FieldRange.Address = FirstAddress
        FieldRange.Value = Placeholder + "."
        FieldRange = Cells.FindNext(FieldRange)
        Placeholder = Placeholder + 1
        If Placeholder = 2000 Then
            Exit Sub
        End If
        Loop

    FieldRange.Value = "WORKS"
End Sub

Placeholder2 将是我要搜索的值。

我期待 WORKS 而不是旧名称,但起初它只是加载了大约 3 个小时,直到我实现了作为“占位符”的生活时间

我正在学习 VBA,来自 C#。

标签: excelvba

解决方案


您需要替换FieldRange.Value = "WORKS"循环内的值。否则,如果它只发生一次,它将无限循环,因为它总是会找到相同的地址并且FieldRange.Address = FirstAddress总是True

While应该在循环的末尾,否则第一个 find 不会替换。

以下应该有效:

Option Explicit

Public Sub One_Find()
    Dim FieldRange As Range
    Set FieldRange = Cells.Find(What:=ActiveCell.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)

    If FieldRange Is Nothing Then
        MsgBox ("Find failed")
        Exit Sub
    End If

    Dim FirstAddress As String
    FirstAddress = FieldRange.Address

    Do 
        FieldRange.Value = "WORKS"
        FieldRange = Cells.FindNext(FieldRange)
    Loop While FieldRange.Address <> FirstAddress
End Sub

推荐阅读