Диапазон форматирования при вводе значения ячейки - PullRequest
0 голосов
/ 29 марта 2019

У меня есть шаблон, в котором пользователь вводит информацию об учетной записи, а диапазон информации по умолчанию - диапазон от B18 до S52. Это хорошо вписывается в экран и является достаточно большим диапазоном для деталей, вводимых в 90% случаев. Однако в некоторых случаях использование может иметь данные в несколько сотен строк. Его обычно копируют и вставляют, но лист будет выглядеть грязно, так как он выходит за пределы диапазона по умолчанию.

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

Код, который я до сих пор изучаю в Интернете:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$18" Then
        Call CountLoc
    End If

End Sub

Public Sub CountLoc()

With Application
    .DisplayAlerts = False
    '.Calculation = xlManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

Dim LocCount As Long
Dim WsInput As Worksheet
Dim i As Long
Dim rng As Range

Set WsInput = Sheets("Account Input")

With WsInput
    LocCount = .Range("B1048576").End(xlUp).row - 17
End With

If LocCount > 35 Then

Set rng = WsInput.Range(WsInput.Cells(18, 2), WsInput.Cells(17 + LocCount, 19))

With rng
    .Interior.Color = RGB(220, 230, 241)
    .Borders.LineStyle = xlContinuous
    .Borders.Color = vbBlack
    .Borders.Weight = xlThin
End With

For i = 1 To LocCount Step 2

Rows(18 + i).EntireRow.Interior.Color = vbWhite

Next i

Else

Exit Sub

End If

По существу, все остальные строки окрашиваются в светло-синий и белый цвета и добавляются границы каждой ячейке. Count Loc работает нормально и делает то, что мне нужно, но проблема у меня заключается в том, что я не могу заставить работать метод sheetheet_Change.

Заранее спасибо

1 Ответ

0 голосов
/ 31 марта 2019

там

Я провел небольшой тест, используя ваш код, и первое, что я заметил, это то, что вы установили Application.EnableEvents to False, и вы не включили его снова, поэтому вы отменяете любое событие, напримерWorksheet_Change Event после того, как это исправлено, событие будет срабатывать каждый раз, когда ячейка B18 изменяется, за исключением случаев, когда введенное значение исходит от вставки (не знаю, почему), но если вы используете метод Intersect, то это работает, даже если значение получено изкопия вставки.

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

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, ThisWorkbook.Sheets("Account Input").Range("B18")) Is Nothing Then
   Call CountLoc
End If
End Sub
Public Sub CountLoc()

Dim LocCount As Long
Dim WsInput As Worksheet
Dim i As Long
Dim rng As Range

Set WsInput = Sheets("Account Input")

With WsInput
 LocCount = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

If LocCount > 35 Then

Set rng = WsInput.Range(WsInput.Cells(18, 2), WsInput.Cells(LocCount, 19))

With rng
    .Interior.Color = RGB(220, 230, 241)
    .Borders.LineStyle = xlContinuous
    .Borders.Color = vbBlack
    .Borders.Weight = xlThin
End With

For i = 18 To LocCount Step 2

Set rng = WsInput.Range(WsInput.Cells(i, 2), WsInput.Cells(i, 19))
rng.Interior.Color = vbWhite

Next i

Else

Exit Sub

End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...