Обернуть строки, которые имеют дубликаты - PullRequest
Новая
       9

Обернуть строки, которые имеют дубликаты

1 голос
/ 10 мая 2011

У меня есть данные, которые выглядят так: 

BOB  | 4
BOB  | 3
BOB  | 7
MARY | 1
JOE  | 2
JOE  | 1
MIKE | 6

Я хочу получить данные, которые выглядят так: 

BOB  | 4 | 3 | 7
MARY | 1 |   |
JOE  | 2 | 1 |
MIKE | 6 |   |

Проблема в том, как мнеучитывать переменную, сколько раз имя появляется?

Ответы [ 2 ]

2 голосов
/ 10 мая 2011

Я придумал следующий код.Такое ощущение, что это может быть чище.

Это будет работать для любого выбранного блока данных на вашем листе (при условии, что он предварительно отсортирован).Выводит на тот же лист в той же области. 

Sub WrapDuplicates()
    Dim data(), i As Long, startCell As Range, rwCnt As Long, col As Long

    data = Selection //pull selected data into an array
    Set startCell = Selection.Cells(1, 1) //Get reference to write results to
    Selection.ClearContents //remove original data
    startCell = data(1, 1) //Output first name
    startCell.Offset(0, 1) = data(1, 2) //Output first value

    rwCnt = 0
    col = 2

    For i = 2 To UBound(data) //Loop through array and check if name is same or not and output accordingly
        If data(i, 1) = data(i - 1, 1) Then
            startCell.Offset(rwCnt, col) = data(i, 2)
            col = col + 1
        Else
            rwCnt = rwCnt + 1
            col = 2
            startCell.Offset(rwCnt, 0) = data(i, 1)
            startCell.Offset(rwCnt, 1) = data(i, 2)
        End If
    Next i
End Sub
0 голосов
/ 10 мая 2011

Я предполагаю, что вы хотите сделать это в коде, основанном на теге excel-vba в вашем посте.

Я также предполагаю, что данные отсортированы по имени, или вы согласны с сортировкой по имени до выполнения кода.

Источник находится на листе 1, цель - на листе 2. Код в Excel VBA.Я проверил с вашими примерами данных, поместив эту подпрограмму в раздел ThisWorkbook в коде Excel и нажав кнопку воспроизведения.

Целевой заголовок каждый раз переписывается, что не идеально с точки зрения производительности, но я не думаю, что это проблема в противном случае.Вы можете заключить его в оператор if, который проверяет целевой столбец index = 2, если это становится проблемой.

Sub ColumnsToRows()

Dim rowHeading
Dim previousRowHeading
Dim sourceRowIndex
Dim targetRowIndex
Dim targetColumnIndex


sourceRowIndex = 1
targetRowIndex = 1
targetColumnIndex = 2

rowHeading = Sheet1.Cells(sourceRowIndex, 1)
previousRowHeading = rowHeading

While Not rowHeading = ""

    If Not previousRowHeading = rowHeading Then
        targetRowIndex = targetRowIndex + 1
        targetColumnIndex = 2
    End If

    Sheet2.Cells(targetRowIndex, 1) = rowHeading
    Sheet2.Cells(targetRowIndex, targetColumnIndex) = Sheet1.Cells(sourceRowIndex, 2)
    previousRowHeading = rowHeading

    sourceRowIndex = sourceRowIndex + 1
    targetColumnIndex = targetColumnIndex + 1
    rowHeading = Sheet1.Cells(sourceRowIndex, 1)

Wend

End Sub

Я разработчик, а не гуру Excel.Там может быть какая-то функция Excel, сводная таблица или другая магия Excel, которая делает это автоматически.

...