Трим / Автофит на изменение эффективно - PullRequest
Новая
       49

Трим / Автофит на изменение эффективно

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

Я изменил существующий макрос на листе, чтобы автоматически обрезать и автоматически подбирать столбцы при изменении ячейки в диапазоне. Это работает, но у меня было два вопроса, на которые я надеялся найти ответы здесь: есть ли способ установить целевой диапазон для того диапазона, который был только что отредактирован (только одна ячейка, если в одну ячейку были введены данные вручную, и диапазон того, что было вставляется, когда диапазон размещается внутри указанного диапазона c); и есть ли способ сделать код у меня уже более эффективным?

Это форма запроса, которая часто имеет несколько имен / идентификаторов, которые используются и мной, и другими, и чаще всего пользователь копирует и вставляет диапазон из 4 столбцов с 30-я sh строками за раз, а не по одному. Там есть несколько IF, чтобы проверить, это ли я, и это только потому, что я получаю форму от других, а затем оборачиваюсь и отправляю ее клиенту, поэтому я не хотел нажимать «незащищать» каждый раз, когда получил один, если что-то было неправильно.

Вот код, как есть: 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim KeyCells2 As Range

Set KeyCells = Range("B13:c14")
Set KeyCells2 = Range("B13:E113")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    Worksheets("Request Sheet").Unprotect
    Range("b4").Value = "=Now()"
    If Right(Environ("userprofile"), 7) <> [my pc userprofile name here] Then
        Worksheets("Request Sheet").Protect
    End If
End If

If Not Application.Intersect(KeyCells2, Range(Target.Address)) Is Nothing Then
    ActiveSheet.Unprotect
    For Each cell In Range("B13:" & Cells(WorksheetFunction.CountA(Range("B13:B113")) + 12, WorksheetFunction.CountA(Range("B13:E13")) + 1).Address)
        cv = cell.Value
        If Right(cell, 1) = " " Or Left(cell, 1) = " " Then
            cell.Value = WorksheetFunction.Trim(cv)
        End If
        ActiveSheet.Rows(cell.Row).EntireRow.AutoFit
        If Rows(cell.Row).RowHeight <> 15.75 Then
        With ActiveSheet
            .Rows(cell.Row).RowHeight = 15.75
            .Columns(cell.Column).EntireColumn.AutoFit
        End With
        End If
        If Columns(2).ColumnWidth < 18.75 Then
            ActiveSheet.Columns(2).ColumnWidth = 18.75
        Else: ActiveSheet.Columns(2).EntireColumn.AutoFit
        End If
        ActiveSheet.Columns(3).EntireColumn.AutoFit
        If Columns(3).ColumnWidth < 15.14 Then
            ActiveSheet.Columns(3).ColumnWidth = 15.14
        End If
        If Columns(4).ColumnWidth < 17.43 Then
            ActiveSheet.Columns(4).ColumnWidth = 17.43
        End If
        If Columns(5).ColumnWidth < 13.86 Then
            ActiveSheet.Columns(5).ColumnWidth = 13.86
        End If
    Next
    ActiveSheet.Rows(9).RowHeight = 24
    ActiveSheet.Rows(10).RowHeight = 19.5
    ActiveSheet.Rows(11).RowHeight = 26.25
    ActiveSheet.Rows(12).RowHeight = 42.75
    If Right(Environ("userprofile"), 7) <> [my pc userprofile name here] Then
        ActiveSheet.Protect
    End If
End If

End Sub
...