В одном листе необходимо два кода изменений

Question

Мне нужно запустить два кода событий изменений (я нашел их на разных сайтах) на одном листе.Я посмотрел на множество примеров, и большинство из них, кажется, объединяют их в одно событие.Однако я не могу понять, как это сделать с моим (или даже если мне нужно).

Первый код - очистить зависимые выпадающие меню:

Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C13")) Is Nothing Then
Range("C14").ClearContents
End If

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C14")) Is Nothing Then
Range("C15").ClearContents
End If

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C13")) Is Nothing Then
Range("C17").ClearContents
End If

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C14")) Is Nothing Then
Range("M14").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C13")) Is Nothing Then
Range("C15").ClearContents
End If

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("C15")) Is Nothing Then
Range("C17").ClearContents
End If

Второй коддля автоматического увеличения поля примечаний объединенной ячейки на рабочем листе:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "Note"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
  .MergeCells = False
  CWidth = .Cells(1).ColumnWidth
  MergeWidth = 0
  For Each cM In AutoFitRng
      cM.WrapText = True
      MergeWidth = cM.ColumnWidth + MergeWidth
  Next
  'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count *      0.66
  .Cells(1).ColumnWidth = MergeWidth
  .EntireRow.AutoFit
  NewRowHt = .RowHeight
  .Cells(1).ColumnWidth = CWidth
  .MergeCells = True
  .RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
End Sub

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

Любая помощь будет оценена, поскольку я совершенно новичок в VBA, и просто изо всех сил пытаюсь что-то завершить на работе.

Answer 1

Вот как будет выглядеть объединенный (и немного очищенный) код:

Sub Worksheet_Change(ByVal Target As Range)

Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double

    ' Check once if we have more than one cell in the Target, if so, leave the sub:
    If Target.Cells.Count > 1 Then Exit Sub

    ' Changes related to Target = C13:
    If Not Intersect(Target, Range("C13")) Is Nothing Then
        Range("C14").ClearContents
        Range("C15").ClearContents
        Range("C17").ClearContents
    End If

    ' Changes related to Target = C14:
    If Not Intersect(Target, Range("C14")) Is Nothing Then
        Range("C15").ClearContents
        Range("M14").ClearContents
    End If

    ' Changes related to Target = C15:
    If Not Intersect(Target, Range("C15")) Is Nothing Then
        Range("C17").ClearContents
    End If

    ' Changes related to Target = Range named "Note":
    If Not Intersect(Target, Range("Note")) Is Nothing Then
        Application.ScreenUpdating = False
        On Error Resume Next
        Set AutoFitRng = Range(Range("Note").MergeArea.Address)
        With AutoFitRng
          .MergeCells = False
          CWidth = .Cells(1).ColumnWidth
          MergeWidth = 0
          For Each cM In AutoFitRng
              cM.WrapText = True
              MergeWidth = cM.ColumnWidth + MergeWidth
          Next
          'small adjustment to temporary width
          MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
          .Cells(1).ColumnWidth = MergeWidth
          .EntireRow.AutoFit
          NewRowHt = .RowHeight
          .Cells(1).ColumnWidth = CWidth
          .MergeCells = True
          .RowHeight = NewRowHt
        End With
        Application.ScreenUpdating = True
    End If
End Sub

Что касается упомянутой вами части: скрытие поля примечаний, я не уверен, что высделал, но это только 2 метода конгломерат.Если они работали хорошо по отдельности, они должны работать так же хорошо в приведенном выше коде.

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

Надеюсь, это поможет вам лучше понять ... VBA определенно стоит понять.