更改事件中的VBA循环错误

我有一个宏，当我在工作表1的单元格A1中写入内容时，它会在工作表2中创建一个文本框，当我删除该值时，它会删除该文本框。 我想为几个细胞做这个，但它只是在工作。如果单元格A1有一个值，则应显示具有该值的文本框；如果单元格A2有一个值，则应显示具有该值的文本框；但如果删除A1，则应删除引用A1的文本框，而不是所有文本框

Sub RemoveShapes()

    Dim shp As Shape
    For Each shp In Worksheets(2).Shapes
        If shp.Type = msoTextBox Then shp.Delete
    Next shp

End Sub

Sub criarcaixastexto()

    Dim wsActive As Worksheet
    Dim box As Shape

    Set wsActive = Worksheets(2)
    Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)

    box.TextFrame.Characters.Text = Range("Folha1!A1").value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        Call criarcaixastexto
    End If
End Sub

我试过了，但没用

'macro para apagar
Sub removercaixas()

    Dim shp As Shape
    For Each shp In Worksheets(2).Shapes
        If shp.Type = msoTextBox Then shp.Delete
    Next shp

End Sub

'macro para criar caixas de texto
Sub criarcaixastexto()

   Dim wsActive As Worksheet
   Dim box As Shape

   Set wsActive = Worksheets(2)
   Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)

   box.TextFrame.Characters.Text = Worksheets(1).Cells(i, 1).Value

End Sub

' macro corre ao escrever texto numa célula
Private Sub Worksheet_Change(ByVal Target As Range)

    For i = 1 To 3
        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A&i")) Is Nothing Then
            removercaixas
        If Len(Target) > 1 Then criarcaixastexto
        End If
    Next

End Sub

---

无论何时调用

RemoveCaixas

，都将删除工作表上的所有文本框。您需要以某种方式将文本框与生成它的单元格链接起来

为什么不用手机地址命名文本框？复制/粘贴此文件：

Sub removercaixas(strName As String)

    Dim shp As Shape
    For Each shp In Worksheets(2).Shapes
        If shp.Type = msoTextBox AND shp.Name = strName Then shp.Delete
    Next shp

End Sub

及

及

---

文本框在工作表2中创建，所有文本框都位于彼此的顶部。它们被适当地删除。如果在$A$1:$A$3中输入的值的长度为1或更短，则不会创建文本框。不确定逻辑是什么，但如果你想用一位数的值来创建一个文本框，只需将

Len（Target）>1

更改为

Len（Target）>0

请你的帖子准确描述错误是什么。“不工作”不是一个有用的问题描述。RemoveCaixas将删除所有文本框形状。你需要使用shp.TopLeftCell.Address来确定位置。我尝试了你的代码，但它不起作用。我得到以下错误：运行时1004。objet工作表的方法范围失败<代码>专用子工作表(如果Target.Count>1，i=1到3的更改（ByVal Target As Range)然后退出子工作表如果不相交（Target，Range（“A”）和CStr（i）），则为空，如果Len（Target.Address）>1，则为criarcaixastexto（Target.Address）End If Next End Sub代码还有两个额外的更改：“len”和“intersect”参数。你确定那些不是罪犯吗？老实说，我对这部分代码的作用感到困惑。这部分代码编译了吗？我的任何改变似乎都不会导致1004。我已经修复了2个编译错误，由于

i

超出范围且未在sub中定义，因此在

框中得到1004。您能否解决所有这些问题，然后让我知道我的更改是否解决了您最初的问题？在更新工作表1中的值时，进行您建议的更改不会删除旧版本的文本框，因此您可以测试了这个代码？很抱歉，我的excel中没有使用该代码。我保留了我的代码并将更改事件更改为：
Private Sub sheet_change（ByVal Target As Range）Call remover caixas Call criarcaixastexto End Sub
它按照我的要求工作，但会由该页面任何单元格中的任何更改触发。我要“轻一点”。如果更接近你的建议，我想要什么。当我在corredpondent单元格中更改某些内容时，我希望texbox更新，但它没有这样做。如果我删除单元格A1，我希望文本框A1被删除，如果我在A2中写了一些东西，我希望文本框被更新
Sub criarcaixastexto(strName As String)

    Dim wsActive As Worksheet
    Dim box As Shape

    Set wsActive = Worksheets(2)
    Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)

    box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
    box.Name = strName

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Select Case Target.Address
        Case "$A$1", "$A$2", "$A$3"
            removercaixas (Target.Address)
        Case Else
            Exit Sub
    End Select
    If Len(Target) > 1 Then criarcaixastexto (Target.Address)
End Sub