在 Sheet 中的灵活区域上划定宏

Question

我是 VBA 的新手，尝试用 2 table 和特定的宏来处理 Sheet。我在一个模块中创建了宏，并放置在名为 Positionen_Einfügen（插入整行）和 Zeile_Löschen（删除整行）的按钮上。

代码运行完美，但现在我想为我的 Wokrsheet(Einzelkosten) 中的特定区域限制这些宏，但该区域仍然是灵活的，因为您可以插入多行或删除一行。

在这种情况下，我在 table 停止的地方放置了一个大红色 "Y"。我的 "Y" 很灵活，如果您使用它们，当然会随着宏一起移动。像往下几行或往上一排。

我想用这个 "Y" 作为 ActiveCell.EntireRow.Select 的寄宿生。那么我可以在我的宏中编写一个 .Find("Y") 函数，就像下面的代码一样：

Position_Einfügen()
'Disable Excel feautres to prevent Errors
ActiveSheet.Unprotect

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

'set specific range for area
Dim Target As Range
Set Target = Range("A9:R200").Find(Y, LookIn:=xlValues)


icountROws = Application.InputBox(Prompt:="How many rows do you want to  insert after Line " _
& ActiveCell.Row & " ?", Type:=1)
' Dont allow negative numbers or empty field: Error Handling
If icountROws <= 0 Then End

ActiveCell.EntireRow.Select
'Can this work?
     If ActiveCell.EntireRow.Select >= Y And ActiveCell.EntireRow.Select = Y Then
     MsgBox ("Sie befinden sich außerhalb des erlaubten Bereichs")
     End If
 Exit Sub
     Else If
     Selection.Copy
     ' Selection.PasteSpecial xlPasteFormulas
     Rows(ActiveCell.Row & ":" & ActiveCell.Row + icountROws - 1).Insert shift:=xlDown
     End If

    'Re-enable features after running macro, auto-debugging
     Application.Calculation = xlCalculationAutomatic
     Application.EnableEvents = True
     Application.ScreenUpdating = True

     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True
     ActiveSheet.EnableSelection = xlNoRestrictions
End Sub

这是2.宏：删除函数

Sub Zeile_Löschen()

'select row to delete
Dim DeletePrompt As Integer

DeletePrompt = MsgBox("Are you sure you want to delete this row?", vbYesNo +   vbQuestion, "Delete")
    ActiveSheet.Unprotect
    If DeletePrompt = vbYes Then
    Rows(ActiveCell.Row).Delete
    Else
        'do nothing
    End If

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
End Sub

Within my black highlighted brackets is the specific area where the code is allowed to run, otherwise Prompt MsgBox("You are outside of the table")

Answer 1

你可以用Target.Row和Activecell.Row操作，像这样：

Set Target = Range("A9:R200").Find("Y", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True) 
   ' note the quotes around Y
If Target Is Nothing Then
    iMaxRow = 200             ' need to set some maximum value even if Y is not found
Else
    iMaxRow = Target.Row
Endif
If Activecell.Row >iMaxRow Then
     Msgbox "out of range"
     End
End
... and here you can continue inserting

同样，您可以使用Target.Column控制水平尺寸。限制插入的行数也很有意义，如下所示：

If ActiveCell.Row + icountROws > iMaxRow Then icountRows = iMAxRow - ActiveCell.Row

尽量避免使用select。在此处查看更多信息：How To Avoid Using Select。无论如何，您不能将整个 (selected) 行与一个值进行比较。

而不是

ActiveCell.EntireRow.Select 'Can this work?
If ActiveCell.EntireRow.Select >= Y And ActiveCell.EntireRow.Select = Y Then

使用

If Target.Value = "Y" Then

或

If Target.Value = "Y" Or Target.Value = "y" Then

而不是

ActiveCell.EntireRow.Select
Selection.Copy

使用

ActiveCell.EntireRow.Copy

在 Sheet 中的灵活区域上划定宏

Delimit macro on flexible area in Sheet

excel

vba

excel-2013