Объедините вхождения «C», когда значения «A» и «B» соответствуют предыдущей строке - PullRequest
Новая
       11

Объедините вхождения «C», когда значения «A» и «B» соответствуют предыдущей строке

0 голосов
/ 02 мая 2018

Очень надеюсь, что вы можете помочь, потому что я ослепну по этому вопросу. Моя таблица содержит 20 столбцов и около 20000 строк. Многие строки являются дубликатами во всех, кроме 1 столбца, и мне нужно объединить все переменные из этого 1 столбца, где строки совпадают. Мои данные в порядке, поэтому все повторяющиеся строки находятся вместе, и в настоящее время у меня есть макрос, но мне приходится выбирать диапазон вручную, что медленно.

У меня вопрос: могу ли я запустить VBA / формулу, которая будет соответствовать каждой дублированной частичной строке на всем листе, а затем объединить уникальную ячейку этих строк? пожалуйста, смотрите мой упрощенный пример.

simple example

1 Ответ

0 голосов
/ 02 мая 2018

Этот код должен делать работу; Я уверен, что этот вопрос будет закрыт за то, что он не по теме (или перенесен в переполнение стека, где он на самом деле принадлежит): 

Sub GatherCountries()
'''Subroutine to loop through rows of column A and concatenate data of column C to column D,
'''when row - 1 == row

'Declare local variable types
Dim worksheetName As String
Dim rowNumber, rowEndNumber As Integer
Dim pasteCell As Range

'Declare local variables
worksheetName = ActiveSheet.Name
rowEndNumber = FindLastRow(worksheetName) 'Function call to function defined below

'Loop through each row, starting at line 2 as header is line 1
    For rowNumber = 2 To rowEndNumber
        With Worksheets(worksheetName) 'Reduce amount of unnecessary repitition
            'Case where cell Ax and Bx equal Ax-1 and Bx-1
            If .Cells(rowNumber, 1) = .Cells(rowNumber - 1, 1) And _
            .Cells(rowNumber, 2) = .Cells(rowNumber - 1, 2) Then
                pasteCell.Value = pasteCell.Value & ", " & .Cells(rowNumber, 3) 'Concatenate country to existing string
            'Case where cell Ax and Bx does not equal Ax-1 and Bx-1, loop will always enter this first
            Else
                Set pasteCell = .Cells(rowNumber, 4) 'Set the cell where concatenation should take place
                pasteCell.Value = .Cells(rowNumber, 3) 'Populate concatenation cell with first entry of country
            End If
        End With
    Next rowNumber
End Sub

Function FindLastRow(ByVal SheetName As String) As Long
'''Function to return the last row number of column A

    Dim WS As Worksheet

    On Error Resume Next
    Set WS = ActiveWorkbook.Worksheets(SheetName)
    FindLastRow = WS.Cells.Find(What:="*", After:=WS.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    On Error GoTo 0

End Function

С помощью еще некоторого кода можно посмотреть, какие столбцы содержат значения для проверки и значения для объединения, но, учитывая структуру примера в вопросе, это будет выполнять работу в соответствии с запросом:

Введите:

CountriesGatheringExcelInput

Вывод после запуска кода:

CountriesGatheringExcelOutput

...