Оператор If сравнивает строки в разных строках, но в одном столбце

Я пытаюсь объединить 2 строки в моей электронной таблице Excel в 1 строку на основе истинности определенного условия.

Я хотел бы, чтобы мой код vba определял, является ли строка символов в строке 2 = строке символов в строке 3.

Если они равны, я хотел бы скопировать всю строку 3 в столбец Q в строке, а затем продолжить сравнение строковых значений строк 3 и 4, 4 и 5 и т. д. с последней использованной строкой электронной таблицы.

Я попытался изменить код, который нашел в Stack Overflow, но все еще не могу запустить свой макрос. Любая помощь в этом будет принята с благодарностью.

Вот ссылка на аналогичную ситуацию, которую я нашел в Stack Overflow, когда изучал, как создать свой код VBA, но мне не удалось заставить образец кода работать на меня. Не уверен, почему. vba - excel - если значение = следующее значение строки, затем скопируйте другое значение

Вот часть рабочего листа Excel, с которым я работаю. Мне пришлось изменить информацию в электронной таблице, чтобы она не была слишком широкой для вставки.

таблица данных участников


person Patsy Clew    schedule 11.04.2018    source источник
comment
пожалуйста, поделитесь своим кодом. Кроме того, символы в строке 2 любого столбца? Копировать в ту же текущую строку? Вы также можете просто использовать вспомогательный столбец, например. A1 = A2 и отфильтруйте по истинному результату и скопируйте.   -  person QHarr    schedule 11.04.2018
comment
Нужны образцы данных и ожидаемые результаты (пожалуйста, укажите более одного совпадения в данных образца). Кроме того, предоставьте любой код, который вы пробовали до сих пор.   -  person tigeravatar    schedule 11.04.2018
comment
С помощью vba вы можете зацикливать сравнение со смещением (1,0), чтобы проверить следующую ячейку ниже, если она находится в том же столбце, и должна завершиться в последней строке - 1, чтобы гарантировать, что вы не сравниваете с пустой ячейкой после используемого диапазона.   -  person QHarr    schedule 11.04.2018
comment
Я обновил сообщение, чтобы включить изображение моей электронной таблицы и то, как она должна работать. Я также сослался на конкретный вопрос и ответ в Stack Overflow, который я пытался изменить для своей конкретной ситуации, но не смог заставить его работать на меня. Большое спасибо, что нашли время, чтобы попробовать и помочь мне. Я очень ценю это.   -  person Patsy Clew    schedule 12.04.2018
comment
Ух ты! Это определенно больше, чем я мог бы создать самостоятельно. Однако, когда я попытался запустить его с моими тестовыми данными, я получил сообщение об ошибке от Visual Basic, говорящее, что нижний индекс находится вне допустимого диапазона. Можете ли вы объяснить, что означает это сообщение об ошибке?   -  person Patsy Clew    schedule 12.04.2018


Ответы (1)


Что-то типа:

 Public Sub ArrangeData()
    Dim i As Long, unionRng As Range, lastRow As Long, counter As Long
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Data")         'change as appropriate
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:G" & lastRow).Sort Key1:=.Range("G2:G" & lastRow), Order1:=xlAscending, Header:=xlYes ' 'Sort to ensure in order (and blanks will be at end

        For i = 3 To .Range("G1").End(xlDown).Row + 1
            If .Cells(i, "G") = .Cells(i - 1, "G") Then
                counter = counter + 1
                .Cells(i, "A").Resize(1, 6).Copy .Cells(i - counter, .Cells(i - counter, .Columns.Count).End(xlToLeft).Column + 1)
            Else
                counter = 0
            End If
        Next i

        For i = 3 To .Range("G1").End(xlDown).Row + 1
            If IsEmpty(.Cells(i, "H")) Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, .Cells(i, "H"))
                Else
                    Set unionRng = .Cells(i, "H")
                End If
            End If
        Next i
        If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub

До:

До

После:

После

person QHarr    schedule 12.04.2018