Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Сведение по признаку, Исправить код VBA Excel
 
Здравствуйте! Пожалуйста, подправьте мой код, ниже пример исходных данных и желаемого результата. Нужно по Номеру короткому(nname) и Уровню(Uroven) сгруппировать строки. Уровень для одного номера может отличаться, но для след. строк Уровень также будет расти внутри группы.
Код
Sub Sostav_po_uzlam()
    Application.ScreenUpdating = False    ' îòêëþ÷àåì îáíîâëåíèå ýêðàíà

    Set wb = ActiveWorkbook

    x = 2 'ÁÛËÎ 2 !!!
    y = 1
    For Each nname In Range("A3:A50000").Cells
    x = x + 1


    nvbom = WorksheetFunction.CountIf(Range(Cells(x, 1), Cells(100000, 1)), nname) ' ÄÎÁÀÂÈË!!!
    For i = 1 To nvbom ' ÄÎÁÀÂÈË!!!
    
    Set IRange = Range(Cells(x, 1), Cells(100000, 1)).Find(What:=nname, LookIn:=xlValues)
    If IRange Is Nothing Then GoTo Sled


    iRow = IRange.Row
    iColumn = IRange.Column
    Uroven = Cells(iRow, 4)

    If iRow = x + 1 Then GoTo Sled ' äîáàâèë åñëè èñêîìàÿ ñòðîêà ñëåä îò èñõîäíîé
    Range(Cells(iRow, 1), Cells(iRow, 20)).Cut
    Cells(x + 1, y).Insert
    Index = iRow
    
    If iRow = x + 1 Then GoTo Sled ' äîáàâèë åñëè èñêîìàÿ ñòðîêà ñëåä îò èñõîäíîé
    
    While Cells(Index, 4).Value > Uroven 'Or Cells(iRow + 1, 4).Value = Uroven
        Index = Index + 1
        x = x + 1 ' ÄÎÁÀÂÈË !!!
        Range(Cells(Index, 1), Cells(Index, 20)).Cut
        Cells(x + 1, y).Insert ' ÁÛËÎ + 0 !!!
    Wend

Next
Sled:
  Next
End Sub
Изменено: romeiro - 24.01.2024 14:25:01
VBA Поиск по части имени
 
Спасибо!
VBA Поиск по части имени
 
Пожалуйста, помогите с поиском по условию, нужно найти ячейки текст в которых содержит 2 определённых фрагмента в виде переменных Find1 и Find2.
Найти вида: некий текст+№+Find1+некий текст+Find2+некий текст. Перепробовал разные варианты, читая форум, но не получается, пример моих попыток
     pattern = "*&№&Find1&*&Find2&*"
     pattern = "*№Find1*Find2*"

   Cells.Find(pattern, , , xlWhole).Activate
   filename = Application.Evaluate("MATCH(" & № & Find1 & & Find2 & "))
   Cells.Find(What:="*№Find1*Find2*", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Страницы: 1
Наверх