У меня есть 2 частных сабвуфера, которые были объединены в код ниже.2-я часть кода, мне нужно определить логику для диапазона.Проблема, с которой я сталкиваюсь, заключается в том, что мой второй код не определяет диапазон, поэтому я не уверен, как определить диапазон?и мои знания VBA не так уж велики!Может ли кто-нибудь помочь мне ввести эту информацию?
Коды перед объединением:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cel As Range
Set rng = Intersect(Target, Range([H2], Cells(Rows.Count,
"H").End(xlUp)))
If rng Is Nothing Then Exit Sub
Application.EnableEvents = False
rng.Offset(, 1).FormulaR1C1 = "=IF(RC[-1]<>"""",R1C[6] & ""-"" &" &
"TEXT(COUNTA(R2C[-1]:RC[-1]),""0000"") & ""-"" & R1C[7],"""")"
Application.EnableEvents = True
End Sub
Код 1 использует P1 и O1 для заполнения автоматического номера в столбце I, если информация предоставлена в H Code 2:
Private Sub Move_blanks_To_Bottom(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Column <> 9 Then Exit Sub
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Sort
key1:=Range("I1"), order1:=xlAscending, Header:=xlYes
End Sub
Код 2 использует столбец I и сортирует значения таким образом, что если в I есть значение, он перемещает строку на следующую доступную строку, где столбец I заканчивается эффективно, если ячейка I пуста, строка перемещается в нижнюю часть.
Объединенный код:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'Do logic for this first range
Dim rng As Range, cel As Range
Set rng = Intersect(Target, Range([H2], Cells(Rows.Count,
"H").End(xlUp)))
If Not Intersect(rng, Target) Is Nothing Then
rng.Offset(, 1).FormulaR1C1 = "=IF(RC[-1]<>"""",R1C[6] & ""-"" &" &
"TEXT(COUNTA(R2C[-1]:RC[-1]),""0000"") & ""-"" & R1C[7],"""")"
End If
'now do logic for the second range (move_blanks_to_bottom)
'2nd LOGIC HERE
If Target.CountLarge = 1 And Target.Column = 9 Then
Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Sort
key1:=Range("I1"), order1:=xlAscending, Header:=xlYes
End If
Application.EnableEvents = True
End Sub
Спасибо!