Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Найти дубликаты и объединить значения строк - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Найти дубликаты и объединить значения строк (Макросы/Sub)
Найти дубликаты и объединить значения строк
vladFo Дата: Среда, 13.01.2016, 12:41 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Проблема такая - есть файл с товарами там есть строки с повторяющимися значениями во всех столбцах кроме 2х - к примеру три строки - у них все столбцы с одинаковыми значениями (например в первом столбце один и тот же артикул) а в столбце размер - разные значения в каждой строке...файл в приложении...возможно ли объединить строки или убрать дубликаты, но так чтоб эти разные значения записались в одну ячейку например через запятую...

было 1|2|3|0
1|2|3|9
1|2|3|8
стало 1|2|3|0,9,8
К сообщению приложен файл: 5565975.xlsx(9Kb)
 
Ответить
СообщениеПроблема такая - есть файл с товарами там есть строки с повторяющимися значениями во всех столбцах кроме 2х - к примеру три строки - у них все столбцы с одинаковыми значениями (например в первом столбце один и тот же артикул) а в столбце размер - разные значения в каждой строке...файл в приложении...возможно ли объединить строки или убрать дубликаты, но так чтоб эти разные значения записались в одну ячейку например через запятую...

было 1|2|3|0
1|2|3|9
1|2|3|8
стало 1|2|3|0,9,8

Автор - vladFo
Дата добавления - 13.01.2016 в 12:41
Manyasha Дата: Среда, 13.01.2016, 13:57 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1832
Репутация: 766 ±
Замечаний: 0% ±

Excel 2007, 2010
vladFo, а Вам обязательно макросом? Сводная не подойдет?
К сообщению приложен файл: 5565975-1.xlsx(15Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеvladFo, а Вам обязательно макросом? Сводная не подойдет?

Автор - Manyasha
Дата добавления - 13.01.2016 в 13:57
wild_pig Дата: Среда, 13.01.2016, 13:58 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 482
Репутация: 90 ±
Замечаний: 0% ±

2003, 2013
так цена разная у одинаковых наименований
 
Ответить
Сообщениетак цена разная у одинаковых наименований

Автор - wild_pig
Дата добавления - 13.01.2016 в 13:58
Manyasha Дата: Среда, 13.01.2016, 14:16 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1832
Репутация: 766 ±
Замечаний: 0% ±

Excel 2007, 2010
wild_pig, не вижу...тыкнете, пожалуйста, носом в такие строчки )


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеwild_pig, не вижу...тыкнете, пожалуйста, носом в такие строчки )

Автор - Manyasha
Дата добавления - 13.01.2016 в 14:16
vladFo Дата: Среда, 13.01.2016, 14:25 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
vladFo, а Вам обязательно макросом? Сводная не подойдет?

Manyasha, не подойдет - мне потом надо сделать импорт csv на сайт ...
 
Ответить
Сообщение
vladFo, а Вам обязательно макросом? Сводная не подойдет?

Manyasha, не подойдет - мне потом надо сделать импорт csv на сайт ...

Автор - vladFo
Дата добавления - 13.01.2016 в 14:25
wild_pig Дата: Среда, 13.01.2016, 14:39 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 482
Репутация: 90 ±
Замечаний: 0% ±

2003, 2013
не вижу...тыкнете

Чуть что сразу потыкать, а поговорить?
Действительно, я ошибся.
[vba]
Код
Sub uuu()
    Dim a(), b()
    Dim i&, j&, rw&
    Dim el
'--------------------
    Application.ScreenUpdating = False
    With ActiveSheet
        a = .UsedRange.Value
        .UsedRange.EntireRow.Delete
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> "" Then
                If .Exists(a(i, 1)) Then
                    b = .Item(a(i, 1))
                    b(15) = b(15) & ", " & a(i, 15)
                    .Item(a(i, 1)) = b
                Else
                    ReDim b(1 To UBound(a, 2))
                    For j = 1 To UBound(a, 2)
                        b(j) = a(i, j)
                    Next
                    .Item(a(i, 1)) = b
                End If
            End If
        Next
        rw = 1
        For Each el In .Items
            Cells(rw, 1).Resize(1, UBound(a, 2)) = el
            rw = rw + 1
        Next
    End With
    Application.ScreenUpdating = True
    Beep
    MsgBox "А ты боялась"
End Sub
[/vba]


Сообщение отредактировал wild_pig - Среда, 13.01.2016, 15:31
 
Ответить
Сообщение
не вижу...тыкнете

Чуть что сразу потыкать, а поговорить?
Действительно, я ошибся.
[vba]
Код
Sub uuu()
    Dim a(), b()
    Dim i&, j&, rw&
    Dim el
'--------------------
    Application.ScreenUpdating = False
    With ActiveSheet
        a = .UsedRange.Value
        .UsedRange.EntireRow.Delete
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> "" Then
                If .Exists(a(i, 1)) Then
                    b = .Item(a(i, 1))
                    b(15) = b(15) & ", " & a(i, 15)
                    .Item(a(i, 1)) = b
                Else
                    ReDim b(1 To UBound(a, 2))
                    For j = 1 To UBound(a, 2)
                        b(j) = a(i, j)
                    Next
                    .Item(a(i, 1)) = b
                End If
            End If
        Next
        rw = 1
        For Each el In .Items
            Cells(rw, 1).Resize(1, UBound(a, 2)) = el
            rw = rw + 1
        Next
    End With
    Application.ScreenUpdating = True
    Beep
    MsgBox "А ты боялась"
End Sub
[/vba]

Автор - wild_pig
Дата добавления - 13.01.2016 в 14:39
vladFo Дата: Среда, 13.01.2016, 17:31 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
wild_pig, hands Отлично! Все работает! Сначала вроде ничего не произошло! но потом поменял колонку в скриптес 15 на 17, которая мне нужна! СПАСИБО!!! :D
 
Ответить
Сообщениеwild_pig, hands Отлично! Все работает! Сначала вроде ничего не произошло! но потом поменял колонку в скриптес 15 на 17, которая мне нужна! СПАСИБО!!! :D

Автор - vladFo
Дата добавления - 13.01.2016 в 17:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Найти дубликаты и объединить значения строк (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!