Как объединить две «Бывалые цели как дальности»

Question

Надеюсь, вы поможете мне с тем, как можно объединить эти два макроса в один? Оба макроса работают нормально независимо, но когда я пытаюсь объединить их, один из них перестает работать. Я пробовал так много вещей, но ни одна из них, похоже, не работает.

Первый макрос показан ниже и автоматически вставляет и копирует строку выше, когда пользователь щелкает указанный диапазон ячеек c. Кроме того, ширина столбцов настраивается автоматически, а форматирование столбцов изменяется.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
    If Not Intersect(ActiveCell, Range("E15:E45")) Is Nothing Then
    With Selection
    .EntireRow.Copy
    .Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown

End With
    End If

       'Automatically autofit columns when changes
    ThisWorkbook.Worksheets("Load").Range("F:N").EntireColumn.AutoFit

    'Format columns 9 (I) as TEXT
    Columns(9).NumberFormat = "@"


End Sub

Второй макрос автоматически вставляет название компании и название проекта в два столбца, когда конечные пользователи вставляют код проекта. Следовательно, это в основном вставка с автоматическим поиском.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range

    If Not Intersect(Range("H:H"), Target) Is Nothing Then
        For Each cell In Intersect(Range("H:H"), Target)
            cell.Offset(0, 1).Interior.ColorIndex = xlNone
            If cell <> "" Then Call macro2(cell)
        Next cell
    End If
End Sub

Sub macro2(T As Range): Dim F As Range, w2 As Worksheet
Set w2 = Sheets("Lookups")
Set F = w2.Range("H:H").Find(T.Value, , , xlWhole)
If Not F Is Nothing Then
T.Offset(0, 1) = F.Offset(0, 1)
T.Offset(0, -1) = F.Offset(0, 2)
Else: T.Offset(0, 1).Interior.ColorIndex = 3: T.Offset(0, 1) = ""
End If
End Sub

Надеюсь, вы сможете помочь :)

Answer 1

Ваша проблема здесь в том, что первый работает на Worksheet_SelectionChange, а второй на Worksheet_Change. Они оба имеют различную функциональность, то есть первый макрос срабатывает при щелчке по ячейке, второй - при изменении ячейки.

Это приводит к проблеме, заключающейся в том, что при объединении второго с первым макросом он будет срабатывать. как только вы щелкнете по ячейке (или нажмете Enter et c.), макрос будет запущен в ячейке, выбранной после вашего действия. Поэтому, если вы нажмете на пустую ячейку, она сработает, обнаружит, что ячейка пуста, и ничего не сделает. Затем, когда вы щелкнете по нему, он выстрелит в новую ячейку и оставит только что измененную ячейку нетронутой. В любом случае, он не будет обрабатываться должным образом.

Один из способов обойти это (я уверен, что есть более элегантные способы) - сохранить последнюю выбранную ячейку в переменной publi c и иметь второй подпроцесс с последней выбранной ячейкой из этой переменной вместо текущей выбранной ячейки:

Option Explicit
Public lastcell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

    If Not Intersect(ActiveCell, Range("E15:E45")) Is Nothing Then
        With Selection
            .EntireRow.Copy
            .Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown
        End With
    End If

    'Automatically autofit columns when changes
    ThisWorkbook.Worksheets("Load").Range("F:N").EntireColumn.AutoFit

    'Format columns 9 (I) as TEXT
    Columns(9).NumberFormat = "@"
    Dim cell As Range

    'if no last cell exists (at opening of workbook) use current cell instead.
    If lastcell Is Nothing Then
        Set lastcell = Target
    End If

    If Not Intersect(Range("H:H"), lastcell) Is Nothing Then
        For Each cell In Intersect(Range("H:H"), lastcell)
            cell.Offset(0, 1).Interior.ColorIndex = xlNone
            If cell <> "" Then Call macro2(cell)
        Next cell
    End If

    'Store current cell as last cell
    Set lastcell = Target

End Sub