Блог

Я очень новичок в VBA и только сейчас начал автоматизировать работу в excel. У меня есть требование объединить значение ячейки на основе двух столбцов. Например

В приведенном выше excel в столбце A, если Doc2 существует трижды, но имеет уровни 3,4 и 3 (в строке с номером 3,4 и 6 соответственно). Я хочу объединить значения идентификатора в один столбец, как показано ниже

На основе уровня и имени документа, если оба они одинаковы, то объединять идентификатор иначе не нужно.

 Sub ConcatenateCellsIfSameValueExists()
DestRowRef = 2
CheckedCell = Cells(2, "A").Value
For i = 2 To Range("A" amp; Rows.Count).End(xlUp).Row   1
    If Cells(i, "A").Value <> CheckedCell Then
        tempConValues = tempConValues
        Cells(DestRowRef, "C").Value = tempConValues
        tempConValues = ""
        DestRowRef = DestRowRef   1
    End If
    tempConValues = tempConValues amp; " " amp; Cells(i, "B").Value
    CheckedCell = Cells(i, "A").Value
Next
End Sub
 

Я попробовал приведенный выше код, он объединяется только на основе одной ячейки, а также повторное имя документа после объединения не удаляется. Кто-нибудь может здесь помочь, пожалуйста?

В VBA я бы использовал словарь для организации данных. Для ключа объедините то, что вы хотите сгруппировать (имя документа и уровень), а для содержимого-объединенные идентификаторы.

 'Set Reference to Microsoft Scripting Runtime
Option Explicit
Sub jugate()
'Declare variables
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim D As Dictionary
    Dim I As Long, V As Variant
    Dim sKey As String
    
'set Source and Result worksheets and ranges
Set wsSrc = ThisWorkbook.Worksheets("sheet4") 'edit to real worksheet
Set wsRes = ThisWorkbook.Worksheets("sheet4") 'could put this on different sheet
    Set rRes = wsRes.Cells(1, 6)
    
'read table into array for fastest processing
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
End With

'read into dictionary, combining like doc/level
Set D = New Dictionary
    D.CompareMode = TextCompare
    
For I = 2 To UBound(vSrc) 'skip header row
    sKey = vSrc(I, 1) amp; "|" amp; vSrc(I, 3)
    If Not D.Exists(sKey) Then
        D.Add Key:=sKey, Item:=vSrc(I, 2)
    Else
        D(sKey) = D(sKey) amp; vbLf amp; vSrc(I, 2)
    End If
Next I

'create results array
ReDim vRes(0 To D.Count, 1 To 3)

'header row
For I = 1 To 3
    vRes(0, I) = vSrc(1, I)
Next I

'populate data
I = 0
For Each V In D.Keys
    I = I   1
    vRes(I, 1) = Split(V, "|")(0) 'doc name
    vRes(I, 2) = D(V) 'concatenated ID
    vRes(I, 3) = Split(V, "|")(1) 'level
Next V

'write results to worksheet
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1)   1, columnsize:=UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes

'Next lines are just for formatting
'not really necessary and not internationally aware
    .Style = "output"
    .EntireColumn.AutoFit
    .VerticalAlignment = xlCenter
End With

End Sub

 

Вы также можете получить желаемый результат с помощью Power Query , доступных в Windows Excel 2010 и Office 365 Excel

• Выберите какую-нибудь ячейку в исходной таблице
• Data => Getamp;Transform => From Table/Range
• Когда откроется пользовательский интерфейс PQ, перейдите к Home => Advanced Editor
• Обратите внимание на название таблицы в строке 2 кода.
• Замените существующий код на приведенный ниже M-код
• Измените имя таблицы в строке 2 вставленного кода на ваше «настоящее» имя таблицы
• Изучите любые комментарии, а также Applied Steps окно, чтобы лучше понять алгоритм и шаги
• После закрытия/загрузки отформатируйте полученную таблицу для переноса слов и центрирования.
  • Это форматирование должно сохраняться при последующих обновлениях.

Код M

 let

//Change table name in next line to your actual table name
    Source = Excel.CurrentWorkbook(){[Name="Table11"]}[Content],

//set data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"DocumentName", type text}, {"ID", type text}, {"Level", Int64.Type}}),

//group by doc name and Level
//then aggregate the text strings
    #"Grouped Rows" = Table.Group(#"Changed Type", {"DocumentName", "Level"}, {
        {"ID", each List.Accumulate([ID],"",
            (state,current)=> if state = "" then current else state amp; "#(lf)" amp; current), Text.Type}
        }),

//Place columns in desired order
    #"Reordered Columns" = Table.ReorderColumns(#"Grouped Rows",{"DocumentName", "ID", "Level"})
in
    #"Reordered Columns"