复制同一行中的值而不是其他列（可变偏移量）Excel VBA

下面的代码确保只有一个范围内的单元格（“D16：E25”）可以包含任何值，当任何值/stringinput到此范围内的其他单元格之一时，代码将删除所有其他单元格。 （这部分工作正常，感谢“macros观人”）

现在，我想要代码复制（并粘贴到“B5”）从列B中的某个单元格的值，这需要是在同一行中的单元格作为范围内的值（“D16：E16” ）。 尝试下面的代码，你可以find…但没有奏效。 安永是否知道这样的溶剂？ 我更喜欢工作簿（单元格“B5”）自动更新，所以不必运行macros或按下button。

If Not Intersect(Target, Range("D16:E25")) Is Nothing Then If Target.Cells.Count > 1 Then MsgBox "Please edit one cell at a time!" Else Application.EnableEvents = False newVal = Target.Value Range("D16:E25").ClearContents Target.Value = newVal a = ActiveCell Application.EnableEvents = True End If End If If a.Column = 4 Then Range("B5") = Range(a).Offset(0, -2).Value Else: Range("B5") = Range(a).Offset(0, -3).Value End If End Sub 

Answer 1

设置一个Range对象可能有点矫枉过正，因为通过查看单个单元格目标已经有了该行。

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D16:E25")) Is Nothing Then On Error GoTo bm_Safe_Exit Application.EnableEvents = False If Intersect(Target, Range("D16:E25")).Cells.Count > 1 Then Application.Undo MsgBox "Please edit one cell at a time!" Else Dim newVal As Variant newVal = Target.Value Range("D16:E25").ClearContents Target.Value = newVal Cells(5, 2) = Cells(Target.Row, 2).Value End If End If bm_Safe_Exit: Application.EnableEvents = True End Sub 

Answer 2

3问题在这里：首先，如果a被设置为一个范围，那么正确的方法是

 Set a = ActiveCell 

其次，如果将a设置为Range，则在第二个if函数中调用它的正确方法是

 If a.Column = 4 Then Range("B5") = a.Offset(0, -2).Value Else: Range("B5") = a.Offset(0, -3).Value End If 

代替

 If a.Column = 4 Then Range("B5") = Range(a).Offset(0, -2).Value Else: Range("B5") = Range(a).Offset(0, -3).Value End If 

第三，上面的if函数应该放在之间

 Set a = ActiveCell 

和

 Application.EnableEvents = True 

那么你的程序将在交叉点为真时按预期运行。