Определение диапазона для 2 частных подпрограмм, которые были объединены - PullRequest
0 голосов
/ 12 сентября 2018

У меня есть 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

Спасибо!

1 Ответ

0 голосов
/ 12 сентября 2018

Ваша команда сортировки в порядке, хотя она довольно сложна, потому что она сжимает серию операций в одну команду. С помощью этой команды вы сортируете диапазон от столбца A до столбца K (= 11) и от строки 1 до последней использованной строки с заголовком. Вы можете разделить эту команду на следующие простые:

Dim lastrow As Long
Dim r As Range

lastrow = Range("A" & Rows.Count).End(xlUp).Row ' find row of last non-blank cell in column A
Set r = Range("A1").Resize(lastrow, 11)   ' set the exact data range
r.Sort key1:=Range("I1"), order1:=xlAscending, Header:=xlYes

но это будет так же, как в вашем коде 2.

Возможно, вам нужно знать, что если вы разбиваете команду на 2 строки, вам нужно завершить строку с помощью _, например:

Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Sort _
    key1:=Range("I1"), order1:=xlAscending, Header:=xlYes

в противном случае компилятор будет обрабатывать их как отдельные команды и выводит сообщение об ошибке синтаксиса.

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