VBA IF Иначе возникают проблемы с циклом, Путаница при сравнении значений и логики

Question

Я сошел с ума от проектов VBA по всему дому и помогал жене поднимать свои отчеты на следующий уровень.У меня проблемы с изложением VBA, о чем я думаю.Если кто-то почувствовал мою боль, пожалуйста, пролите немного света на настоящий сценарий, который поможет мне преодолеть этот горб.Сводка может сравнивать значение ячейки для определенного текста, используя InStr, и, если не существует, добавляющие символы в правом конце.Я могу добавить и выполнить через один цикл цикла, но путаюсь с попыткой написать логику, о которой я думаю.

Небольшая справочная информация в отчете: одна строка равна одному резервированию.В этом ряду есть колонка с надписью «Ночи».Этот столбец фильтруется для любого бронирования с более чем «1» ночью.Пример: может быть 3 ночи, 6 ночей и 10 ночей не имеет значения.У меня есть макрос, который сортирует эти резервирования и разбивает одно резервирование на несколько строк, что составляет общее число в столбце «Ночи».В основном, копирование и вставка строк рядом друг с другом.Пока этот фильтр все еще применяется (только SpecialVisibleCells).Теперь у меня есть еще один столбец с меткой «ResNumber»Если 3, 6 или 10 строк разделены, столбец «ResNumber» - это одно и то же число.Мне поручено пройтись по этому столбцу ResNumber и добавить «-1» для первого ряда.«-2» для второго резервирования «-3» для третьего и, возможно, четвертого «-4» до последнего ряда, скопированного для этой одной группы резервирования.Затем цикл (цикл) начинается снова для следующей группы или блока строк.Та же процедура.

Dim lnrow As Integer Dim llrow As String Dim rownuml As Integer 'проверка строки Dim colnuml As String' средство проверки столбцов Dim Count As Integer Dim total As String 'Значение столбца резервирования "Nights" Смещение (, 17) Dimstartnum As Integer 'Начальный номер для счетчика Dim actcell As String' Activecell startnum = 1 С sh llrow = .Cells (.Rows.count, 2) .End (xlUp) .row If llrow = "" Затем выйдите из Sub .Cells (2, 2) .Resize (llrow - 1) .SpecialCells (xlCellTypeVisible). Выберите

     For lnrow = 2 To llrow
     rownuml = ActiveCell.row
     colnuml = ActiveCell.Column
     total = ActiveCell.offset(, 17).Value

     For count = 1 To total
     rownuml = ActiveCell.row
     colnuml = ActiveCell.Column
     actcell = ActiveCell.Value

'Compares row 1 and checks resNumber value for "-1" if none exist it appends.
                   If InStr(ActiveCell.Value, "-1") = 0 Then
                        ActiveCell.Value = ActiveCell.Value & "-1"
                     Else
                     GoTo nexrow
                    End If

'Compares row 2 and checks resNumber value of above cell.
           If InStr(ActiveCell.offset(-1, 0).Value, "-1") = 0 Then
                      Resume Next
                    If InStr(ActiveCell.Value, "-2") = 0 Then
                        ActiveCell.Value = ActiveCell.Value & "-2"
                     GoTo nexrow
                    End If

', чтобы выпрыгнуть из цикла nexrow' ActiveCell перемещается на одну строку вниз.ActiveCell.offset (1, 0) .SpecialCells (xlCellTypeVisible) .Select rownuml = ActiveCell.row 'просто проверяет номер строки colnuml = ActiveCell.Column' просто проверяет номер столбца

', поскольку 1-е резервирование уже находится в БДstartnum начинается с # 1. Счетчик startnum = startnum + count Следующий счет Next End With

Answer 1

Попробуйте:

Option Explicit

Sub test()

    Dim LastRow As Long, Times As Long, Counter As Long, i As Long, y As Long
    Dim strNumber As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 2 To LastRow

            strNumber = .Range("B" & i).Value

            Times = Application.WorksheetFunction.CountIf(.Range("B2:B" & LastRow), strNumber)

            If Times > 1 Then

                Counter = 1

                For y = 2 To LastRow

                    If strNumber = .Range("B" & y).Value Then

                        .Range("B" & y).Value = strNumber & " - " & Counter
                        .Range("D" & y).Value = 1
                        Counter = Counter + 1

                    End If

                Next y

            End If

        Next i

    End With

End Sub

Результаты: