Всем привет! Не подскажите можно ли для каждого субъекта в отдельности (колонка E) объединять наименования из колонки G при условии что у них одинаковые значения если не найдено аналогичного абсолютного значения то просто записывать наименование в отдельной строке если несколько районов то перед районами ставить слово "район" если несколько городских округов то перед городскими округами ставить "городские округа"! самая последняя строчка в колонке G для соответствующего субъекта где написано допустим "18 муниципальных образований" должно всегда идти отдельно без объединений с другими ячейками как это должно выглядеть представлено в столбце M и N! заранее спасибо за помощь!
конечно же можно добавлять любое количество промежуточных столбцов!
Всем привет! Не подскажите можно ли для каждого субъекта в отдельности (колонка E) объединять наименования из колонки G при условии что у них одинаковые значения если не найдено аналогичного абсолютного значения то просто записывать наименование в отдельной строке если несколько районов то перед районами ставить слово "район" если несколько городских округов то перед городскими округами ставить "городские округа"! самая последняя строчка в колонке G для соответствующего субъекта где написано допустим "18 муниципальных образований" должно всегда идти отдельно без объединений с другими ячейками как это должно выглядеть представлено в столбце M и N! заранее спасибо за помощь!
конечно же можно добавлять любое количество промежуточных столбцов!АЛЕКСАНДР1986
Sub test() Application.ScreenUpdating = False lr = Cells(Rows.Count, "g").End(xlUp).Row Range("m4:n" & Cells(Rows.Count, "n").End(xlUp).Row).ClearContents With CreateObject("scripting.dictionary") For i = 4 To lr If Cells(i, "g") <> 0 Then If .Exists(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) Then .Item(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) = .Item(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) & _ ", " & vbLf & Cells(i, "g") Else .Add Trim(Cells(i, "e") & "|" & Cells(i, "h")), Cells(i, "g") End If End If Next i arrKeys = .keys arrItems = .items For i = 0 To UBound(arrItems) Cells(i + 4, "m") = Split(arrKeys(i), "|")(0) Cells(i + 4, "n") = arrItems(i) Next i End With End Sub
[/vba] с районами и округами уже некогда разбираться, может кто-то доделает.
АЛЕКСАНДР1986, примерно так можно: [vba]
Код
Sub test() Application.ScreenUpdating = False lr = Cells(Rows.Count, "g").End(xlUp).Row Range("m4:n" & Cells(Rows.Count, "n").End(xlUp).Row).ClearContents With CreateObject("scripting.dictionary") For i = 4 To lr If Cells(i, "g") <> 0 Then If .Exists(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) Then .Item(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) = .Item(Trim(Cells(i, "e") & "|" & Cells(i, "h"))) & _ ", " & vbLf & Cells(i, "g") Else .Add Trim(Cells(i, "e") & "|" & Cells(i, "h")), Cells(i, "g") End If End If Next i arrKeys = .keys arrItems = .items For i = 0 To UBound(arrItems) Cells(i + 4, "m") = Split(arrKeys(i), "|")(0) Cells(i + 4, "n") = arrItems(i) Next i End With End Sub
[/vba] с районами и округами уже некогда разбираться, может кто-то доделает.Manyasha