Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
внести изменение в нумерованный диапазон VBA, вариации на тему нумерация диапазона по условию
 
#1
11.12.2018 18:14:10
Добрый день! Пытаюсь написать макрос, который бы прерывал нумерацию диапазона в зависимости от условия и начинал нумеровать диапазон далее начиная с 1. Если на примере, пытаюсь сделать чтоб нумерация (в колонке A) прекращалась, если в диапазоне  (колонке С) встречается определенное слово (например "яблоко" - см мой файл с примером), ну или чтоб нумерация заканчивалась на определенном слове (например "геркулес"). Что-то туплю уже долго - прошу профи поправить мой код ниже. Пытался найти ответ на сайте - не нашел. Если есть, прошу тыкнуть!

Спасибо!
 
Код
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
N = 1

For r = 1 To LastRow Step 1
    'если значение в ячейке в строке i столбца 3 = непустая и строка не скрытая, то
    If Cells(r, 3) <> "" And Rows(r).Hidden = False Then
                
        Cells(r, 1) = N
        N = N + 1
        
    End If
    Next r
 
   
 
 
 
#2
11.12.2018 18:23:39
Макрос
 
 
 
#3
11.12.2018 18:27:38
Код
    Columns(1).ClearContents
    
    For r = 1 To LastRow
        If Rows(r).Hidden = False Then
            If Cells(r, 3).Value <> "" Then
                N = N + 1: Cells(r, 1).Value = N
            Else
                N = 0
            End If
        End If
    Next r

Step 1 не обзательно.
 
 
 
#4
12.12.2018 00:14:41
Karataev и Vikttur, спасибо, но... сейчас "нумерация обновляется" после пустой строки, а как прописать в макросе чтоб нумерация (в колонке A) обновлялась именно после ключевого слова в колонке C?
 
 
 
#5
12.12.2018 00:43:21
Код
    For r = 1 To LastRow
        If Cells(r, 3).Value = "золотой_ключ" Then bFlag = True
        
        If bFlag = True Then
            If Rows(r).Hidden = False Then
                If Cells(r, 3).Value <> "" Then
                    N = N + 1: Cells(r, 1).Value = N
                Else
                    N = 0
                End If
            End If
        End If
    Next r
 
 
 
#6
12.12.2018 00:54:23
Duke2, ?
Код
Sub ВставитьНумерацию()
Dim r&, n&
  For r = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    If Not Rows(r).Hidden Then
      Select Case LCase$(Cells(r, 3))
      Case ""
      Case "яблоко":        n = 1: Cells(r, 1) = n
      Case "геркулес":      n = n + 1: Cells(r, 1) = n: n = 0
      Case Else:            n = n + 1: Cells(r, 1) = n
      End Select
    End If
  Next r
End Sub
 
 
 
#7
12.12.2018 00:59:33
Vikttur, Казанский - спасибо - утром протестю, напишу!
 
 
 
#8
12.12.2018 14:51:00
Код
Sub ВставитьНумерацию()

   
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
n = 1

For r = 1 To LastRow Step 1 'если значение в ячейке в строке i столбца C = непустая и строка не скрытая, то
     If Cells(r, 3) <> "" And Rows(r).Hidden = False Then
     If Cells(r, 4).Value = Cells(r - 1, 4) Then 'если значение в столбце D не изменилось
     
     Cells(r, 1) = n 'то значение в ячейке в строке i столбца A  - "1"
        n = n + 1 'соответсвенно далее нумерация строк будет увеличиваться на "1" при соблюдении условий выше
        Else: n = 0 + n
         End If
         Else
        n = 0 + n 'если проскакивает пустая строка или скрытая, то строка не считается, но счетчик не обнуляется
        End If
        
        
    Next r
  
    
End Sub

Что-то не работает как-надо ничего (у Karataev не добрался до макроса). Наверное я вводные данные не очень ясно изъяснил... Решил "упростить". Добавил группировочный признак (в колонке D). (приложил файл)  Соответсвенно, нумерация должна быть внутри каждой Группы (Групп может быть больше чем 2) . Написал код (выше), предполагал, что нумерация будет обновляться когда изменится название Группы в колонке D. Ошибка здесь (скорее всего некорректно ссылаюсь на вышестоящую ячеку)  If Cells(r, 4).Value = Cells(r - 1, 4). Предложите плиз как изменить код...Спасибо

Изменено: Duke2 - 12.12.2018 14:57:34
 
 
 
#9
12.12.2018 16:33:39
ок. Таки родил чего хотел. взял идею Vikttur выше. длинноватенький конечно вариант, хотелось бы поизящнее, но тоже работает. Спасибо всем!
Код
Sub numbering()
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'îïðåäåëÿåì ðàçìåðû òàáëèöû
    Application.ScreenUpdating = False
    
    n = 1
    m = 1
    o = 1
For r = 1 To LastRow
        If Cells(r, 4).Value = "frts" And Cells(r, 3).Value <> "" And Rows(r).Hidden = False Then
Cells(r, 1).Value = n
                    n = n + 1
            End If
        If Cells(r, 4).Value = "vgtbls" And Cells(r, 3).Value <> "" And Rows(r).Hidden = False Then
              Cells(r, 1).Value = m
                    m = m + 1
            End If
            If Cells(r, 4).Value = "dshs" And Cells(r, 3).Value <> "" And Rows(r).Hidden = False Then
       Cells(r, 1).Value = o
                    o = o + 1
            End If
    Next r

End Sub
Изменено: Duke2 - 12.12.2018 16:37:40
 
 
 
Страницы: 1
Наверх