以复制功能VBA/Excel中

Question

晚上都更有效的方法，

我有一些代码，我已经工作了一点麻烦，想知道是否有人将能够帮助我。

我有一个Excel工作表，我需要使用Vlookup自动添加框大小，然后锁定单元格，除非选择了“其他”，并在公式删除后替换它们。一切正在完美地为每条线分别编写代码。不过，我需要运行这700多行，我不写这700次，因为这是荒谬的。我试过各种循环来解决这个问题，但我被困住了。

有人可以告诉我如何有效地运行这个x的行数？ 因此，这对第11行非常适用，并且当写入x次时它适用于多行。当解决方案出现时，我可能会踢自己，这太令人沮丧了。

Private Sub lock_repair(ByVal Target As Range) 
'Box 1 
ActiveSheet.Unprotect Password:="pass" 
If Target.Cells(1).Address = "$C$11" And Target.Cells(1).Value <> "OTHER" Then 
    Range("D11").Formula = "=IFERROR(VLOOKUP(C11, Data!$D$5:$G$24, 2,FALSE),0)" 
    Range("E11").Formula = "=IFERROR(VLOOKUP(C11, Data!$D$5:$G$24, 3,FALSE),0)" 
    Range("F11").Formula = "=IFERROR(VLOOKUP(C11, Data!$D$5:$G$24, 4,FALSE),0)" 

    ActiveSheet.Range("D11:F11").Locked = True 

ElseIf Target.Cells(1).Address = "$C$11" And Target.Cells(1).Value = "OTHER" Then 

    ActiveSheet.Range("D11:F11").Locked = False 


End If 
ActiveSheet.Protect Password:="pass", UserInterfaceOnly:=True 

End Sub 

提前欢呼。 Dave

Answer 1

你是对的。您需要首先在备份上进行测试。

Private Sub lock_repair(ByVal Target As Range) 
    'Box 1 
    ActiveSheet.Unprotect Password:="pass" 
    If Target.Cells(1).Column = 3 And Target.Cells(1).Value <> "OTHER" Then 
     Range("D" & Target.Row).Formula = "=IFERROR(VLOOKUP(C" & Target.Row & ", Data!$D$5:$G$24, 2,FALSE),0)" 
     Range("E" & Target.Row).Formula = "=IFERROR(VLOOKUP(C" & Target.Row & ", Data!$D$5:$G$24, 3,FALSE),0)" 
     Range("F" & Target.Row).Formula = "=IFERROR(VLOOKUP(C" & Target.Row & ", Data!$D$5:$G$24, 4,FALSE),0)" 

     ActiveSheet.Range("D" & Target.Row & ":F" & Target.Row).Locked = True 

    ElseIf Target.Cells(1).Column = 3 And Target.Cells(1).Value = "OTHER" Then 

     ActiveSheet.Range("D" & Target.Row & ":F" & Target.Row).Locked = False 


    End If 
    ActiveSheet.Protect Password:="pass", UserInterfaceOnly:=True 

    End Sub