Макрос для автоматического добавления 5 строк ниже ячейки со значением бета и фокусировки на первой новой добавленной строке с использованием VBA

Question

Здесь я динамически принимаю 2 значения: «StartRng» -> где добавить строки & «RowCount» -> Нет строк, которые нужно добавить.

Теперь у меня есть начальный диапазон как «Beta» & RowCount как 5, который теперь является c. Мне нужно найти значение "Beta" и назначить его как startRng без использования inputBox, который я сейчас использую. Затем, где присутствует «Бета», мне нужно добавить 5 строк ниже и сосредоточиться на первой добавленной строке вместо последней.

Ниже приведен код, который я использую. Есть ли какие-то простые настройки, чтобы я мог получить желаемый результат.

Sub BlankLine()
'Updateby20200123
'Author David Nithin Rajan
Dim Rng As Range
Dim WorkRng As Range
Dim StartRng As String
Dim RowCount As Integer
On Error Resume Next
xTitleId = "AddRows"
StartRng = Range("G1").Value --> use this code for dynamic value setting
RowCount = Range("I1").Value --> use this code for dynamic value setting
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", AddRows, WorkRng.Address, Type:=8)
Set WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
For xRowIndex = xLastRow To 1 Step -1
Set Rng = WorkRng.Range("A" & xRowIndex)        
If LCase(Rng.Value) = LCase(StartRng) Then
Rng.Offset(0, 0).EntireRow.Offset(1).Resize(RowCount).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove_ ActiveCell.EntireRow.Copy
ActiveCell.Offset(0).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
If LCase(Rng.Value) <> LCase(StartRng) Then
MsgBox ("Selected cell value ( " + Rng.Value + " ) must be same as 'Insert Row After' column data (" + StartRng + ")!!!")
End If
Next
Application.ScreenUpdating = True
End Sub

Я новичок в Excel VBA. Приведенный выше код любезно предоставлен Google Search и базой c выпусков, ориентированных на вывод.

Answer 1

Я не совсем уверен, что вы пытаетесь сделать, но, может быть, это вас начнёт.

Sub x()

Dim rFind As Range, r As Range

With Sheet1.Columns(1)
    Set rFind = .Find(What:="Beta", lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'find beta
    If Not rFind Is Nothing Then                                          'if found
        rFind.Offset(1).Resize(5).Insert shift:=xlDown                    'insert 5 cells underneath
        MsgBox rFind.Offset(1).Address                                    'address of cell under beta
        Set r = rFind.Offset(1)                                           'or can assign to range variable
    End If
End With

End Sub