Проблема такая - есть файл с товарами там есть строки с повторяющимися значениями во всех столбцах кроме 2х - к примеру три строки - у них все столбцы с одинаковыми значениями (например в первом столбце один и тот же артикул) а в столбце размер - разные значения в каждой строке...файл в приложении...возможно ли объединить строки или убрать дубликаты, но так чтоб эти разные значения записались в одну ячейку например через запятую...
было 1|2|3|0 1|2|3|9 1|2|3|8 стало 1|2|3|0,9,8
Проблема такая - есть файл с товарами там есть строки с повторяющимися значениями во всех столбцах кроме 2х - к примеру три строки - у них все столбцы с одинаковыми значениями (например в первом столбце один и тот же артикул) а в столбце размер - разные значения в каждой строке...файл в приложении...возможно ли объединить строки или убрать дубликаты, но так чтоб эти разные значения записались в одну ячейку например через запятую...
было 1|2|3|0 1|2|3|9 1|2|3|8 стало 1|2|3|0,9,8vladFo
Чуть что сразу потыкать, а поговорить? Действительно, я ошибся. [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]
Код
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