Кнопка VBA - основана на значении ячейки, а не ActiveCell - PullRequest
0 голосов
/ 22 марта 2020

Я очень новичок в VBA и пытаюсь обновить приведенный ниже код, чтобы искать значение в ячейке, а не в ActiveCell. В частности, я хочу найти строку ниже ячейки со значением «B». (например), скопируйте 3 строки ниже и вставьте + вставьте эти 3 строки непосредственно под скопированные 3 строки. По сути, я пытаюсь заставить мою кнопку VBA работать, не прося пользователей сначала щелкнуть мышью по указанной ячейке c. Мой текущий код, основанный на ActiveCell, работает хорошо, пока вы находитесь в правильная клетка. Любое понимание будет полезно.

Sub CommandButton2_Click()
    Dim NextRow As Long
    Dim I As Long

    With Range(ActiveCell.Offset(rowOffset:=2), ActiveCell.Offset(rowOffset:=0))
        NextRow = .Row + .Rows.Count
        Rows(NextRow & ":" & NextRow + .Rows.Count * (1) - 1).Insert Shift:=xlDown
        .EntireRow.Copy Rows(NextRow & ":" & NextRow + .Rows.Count * (1) - 1)
        .Resize(.Rows.Count * (1 + 1)).Sort key1:=.Cells(1, 1)
    End With
End Sub

1 Ответ

0 голосов
/ 22 марта 2020

Пожалуйста, проверьте следующий обновленный код. Для этого потребуется строка / текст ячейки, которую нужно идентифицировать (в InputBox). Для проверки я использовал строку «testSearch». Пожалуйста, поместите это в ячейку A: A, чтобы быть идентифицированным и проверьте это. Затем вы можете использовать любую нужную вам строку ...

Sub testTFindCellFromString()
  Dim NextRow As Long, I As Long, strSearch As String
  Dim sh As Worksheet, actCell As Range, rng As Range

   strSearch = InputBox("Please, write the string from the cell to be identified", _
                      "Searching string", "testSearch")
   If strSearch = "" Then Exit Sub
   Set sh = ActiveSheet
   Set rng = sh.Range("A1:A" & sh.Range("A" & Cells.Rows.Count).End(xlUp).Row)
   Set actCell = testFindActivate("testSearch", rng)
   If actCell Is Nothing Then Exit Sub

   With Range(actCell.Offset(2, 0), actCell.Offset(0, 0))
        NextRow = .Row + .Rows.Count
        Rows(NextRow & ":" & NextRow + .Rows.Count * (1) - 1).Insert Shift:=xlDown
        .EntireRow.Copy Rows(NextRow & ":" & NextRow + .Rows.Count * (1) - 1)
        .Resize(.Rows.Count * (1 + 1)).Sort key1:=.Cells(1, 1)
    End With
  Debug.Print actCell.Address
End Sub
Private Function testFindActivate(strSearch As String, rng As Range) As Range
   Dim actCell As Range
   Set actCell = rng.Find(What:=strSearch)
   If actCell Is Nothing Then
        MsgBox """" & strSearch & """ could not be found..."
        Exit Function
   End If
   Set testFindActivate = actCell
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...