Макрос разделителя на гибкой области в листе

Question

Я новичок в VBA и пытаюсь обработать лист с двумя таблицами и конкретными макросами.Я создал макросы в одном модуле и поместил их в кнопки: Positionen_Einfügen (вставить целые строки) и Zeile_Löschen (удалить всю строку).

Код работает идеально, но теперь я хочу ограничить эти макросы для определенной областив моем Wokrsheet (Einzelkosten), но область по-прежнему гибкая, так как вам разрешено вставлять несколько строк или удалять одну строку.

В этом случае я поместил большую красную букву "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. Delete: Delete Function

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

В моих черных скобках выделена область, в которой разрешено выполнение кода, в противном случае Prompt MsgBox («Вы находитесь за пределами таблицы»)

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.Подробнее здесь: Как избежать использования Выберите .Во всяком случае, вы не можете сравнить всю (выбранную) строку со значением.

Вместо

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