Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Суммировать значения повторяющихся артикулов, повторы удалять
 
#1
18.11.2015 00:27:47
Доброго времени суток. Очень нужна помощь. Нужен марос для суммирования колонки "учет" - Допустим в паллете №1 есть перечень артикулов, некоторые повторяются! Нужно повторяющиеся артикула удалять, а их учет суммировать, но не выходить за рамки поддонов, тобишь "Поддон №1 не нужно суммировать с поддоном№6. Пример таблицы прикрепил. Заранее благодарен.
 
 
 
#2
18.11.2015 00:41:09
А обязательно макросом? Сводная таблица - не подойдет? (см.файл)
Кому решение нужно - тот пример и рисует.
 
 
 
#3
18.11.2015 00:45:50
Пытливый,нужен макрос. Со сводными таблицами я сам могу работать, а так как с данным файлом работает очень большое кол-во людей, то нужно упростить действие до макроса.И формат должен быть в такой форме.
 
 
 
#4
18.11.2015 01:38:41
Если нужен макрос - то вот, на скорую руку поправил автозаписанный:
Код
Sub t_65()
Dim lngI As Long
'определяем последнюю заполненную строку
lngI = Cells(Rows.Count, 1).End(xlUp).Row
'фильтруем и сортируем по номеру, артикулу, наименованию диапазон по последнюю заполненную
Range("A1").AutoFilter
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A2:A" & lngI), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "B2:B" & lngI), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "C2:C" & lngI), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'запускаем цикл снизу-вверх от последней до 2 строки - проверяем, если артикул
    'с наименованием совпадают - суммируем значение из количества, и удаляем строку
    For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(lngI, 2) = Cells(lngI - 1, 2) And Cells(lngI, 3) = Cells(lngI - 1, 3) Then
            Cells(lngI - 1, 5) = Cells(lngI - 1, 5) + Cells(lngI, 5)
            Rows(lngI).Delete shift:=xlUp
        End If
    Next lngI
    'восстанавливаем нумерацию
    Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=R[-1]C+1"
End Sub
Кому решение нужно - тот пример и рисует.
 
 
 
#5
18.11.2015 22:45:16
Пытливый,Почему-то не работает!((( Мне нужно этот код вставить в кнопку, а вставляю а она выдаёт ошибку!(
 
 
 
#6
19.11.2015 00:13:10
Какую ошибку-то хоть? На какой строке кода?
У меня все работает...
Кому решение нужно - тот пример и рисует.
 
 
 
#7
19.11.2015 00:49:08
Пытливый,Ссори код работает, только у меня файл очень большой (более 6000 строк и 500 поддонов) очень долго делает операцию.Может есть способ сократить время или хотя бы вывести строку состояния сколько ещё ждать окончания процесса?
 
 
 
#8
19.11.2015 00:58:26
Извините, мое кунг-фу не настолько сильно... :)
Может, более опытные камрады добавят со строкой.
Кому решение нужно - тот пример и рисует.
 
 
 
#9
19.11.2015 00:59:40
Пытливый,Понятно, спасибо за помощь.
 
 
 
#10
19.11.2015 01:12:36
А куда нужно выводить результат?
 
 
 
#11
19.11.2015 01:15:21
Юрий М,Не понял вопроса? Можете повторить вопрос?
 
 
 
#12
19.11.2015 01:17:39
Как должна выглядеть итоговая таблица и где она должна быть размещена? Вы в файле не показали...
 
 
 
#13
19.11.2015 01:24:10
Юрий М, Подгружаю файл с точным видом как должно выглядеть. Я бы загрузил сам файл, но он превышает допустимый размер.
 
 
 
#14
19.11.2015 01:31:43
И чем второй файл отличается от первого?
 
 
 
#15
19.11.2015 01:35:38
Юрий М,Расположением и самой таблицей. Так как прошлый код портит весь вид (шапка таблицы изменяется) Думал сам исправлю, но как то не получается и колонка учёт не суммирует. Что я не так делаю?
 
 
 
#16
19.11.2015 01:41:57
Попробую сделать, как понял.
 
 
 
#17
19.11.2015 02:13:11
Так?
 
 
 
#18
19.11.2015 02:15:07
Только сейчас заметил, что можно было к штрихкодам привязываться - было бы покороче ))
 
 
 
#19
19.11.2015 02:19:23
Юрий М,Вот что-то подобное, но можно, чтоб подтягивало в том же листе в котором и перечень? и просьба его написать в файле, который во вложении, К штихкоду лучше не подтягиваться, так как
на один товар может быть много разных штихкодов
 
 
 
#20
19.11.2015 02:24:32
Цитата
Элимдар Мингачёв написал:  можно, чтоб подтягивало в том же листе в котором и перечень?
А я ведь спрашивал
Цитата
Юрий М написал: Как должна выглядеть итоговая таблица и где она должна быть размещена?
По поводу второго файла: скопируйте из него данные на первый лист "моего" файла.
 
 
 
#21
19.11.2015 02:32:56
Юрий М,Перенёс в свой файл, единственное изменил название листа! Процесс зачищает полностью всю таблицу!((( Ошибку не выдаёт. Как исправить?
 
 
 
#22
19.11.2015 02:35:24
Название листа нужно менять и в коде. У меня очищается диапазон на АКТИВНОМ листе.
Если бы внимательно читали, что Вам пишут - вопросов бы не было.
 
 
 
#23
19.11.2015 02:39:38
Юрий М,Извините.
Название листа я изменил в коде. Или где-то нужно было ещё?
Код
Dim Uniq As New Collection, LastRow As Long, i As Long, j As Long, x As Long, Arr()
Dim Art As Long, Pall As Integer
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range(Cells(2, 1), Cells(LastRow + 1, 8)).ClearContents
    With Sheets("Накопительная")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        Arr = Range(.Cells(2, 2), .Cells(LastRow, 9)).Value
    End With
    For i = 1 To UBound(Arr)
        Arr(i, 8) = Arr(i, 1) & "|" & Arr(i, 7)
    Next
    For i = 1 To UBound(Arr)
        On Error Resume Next
        Uniq.Add Arr(i, 8), CStr(Arr(i, 8))
    Next
    x = 1
    ReDim arr2(1 To Uniq.Count, 1 To 8)
    For i = 1 To Uniq.Count
        Art = Split(Uniq(i), "|")(0)
        Pall = Split(Uniq(i), "|")(1)
        arr2(x, 1) = x
        arr2(x, 2) = Art
        For j = 1 To UBound(Arr)
            If Arr(j, 1) = Art Then
                If Arr(j, 7) = Pall Then
                    arr2(x, 3) = Arr(j, 2)
                    arr2(x, 4) = Arr(j, 3)
                    arr2(x, 5) = arr2(x, 5) + Arr(j, 4)
                    arr2(x, 6) = CStr(Arr(j, 5))
                    arr2(x, 8) = Pall
                End If
            End If
        Next
        x = x + 1
    Next
    Cells(2, 1).Resize(x - 1, 8).Value = arr2
End Sub
 
 
 
#24
19.11.2015 02:46:34
Нет, только в одном месте. Макрос должен запускаться со второго листа - на котором формируется итоговая таблица.
 
 
 
#25
19.11.2015 02:54:48
Юрий М,Попробовал просто скопировать весь лист в новый Лист 1 всё работает, единственное сортирует со 2 строки, а нужно с 5. - Подскажите пожалуйста где поменять?
А в том же листе нельзя запускать?
 
 
 
#26
19.11.2015 06:40:22
Всё можно. Но нужно СРАЗУ обговаривать все нюансы.
 
 
 
#27
19.11.2015 10:25:11
добрый день,еще вариант макроса,результат на листе Лист3,кнопка yyy на листе Лист 1
Код
Sub yyy()
    Dim z(), i&, j&, m&, k&, i1
    i1 = Sheets("Лист1").Range("A" & Cells.Rows.Count).End(xlUp).Row
    z = Sheets("Лист1").Range("A2:H" & i1).Value
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 1 To UBound(z)
        t = z(i, 2) & z(i, 3)
            If .exists(t) = False Then
                m = m + 1: .Item(t) = m: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next
            Else
             z(.Item(t), 5) = z(.Item(t), 5) + z(i, 5)
            End If
        Next
    Sheets("Лист3").Range("A2").Resize(.Count, UBound(z, 2)) = z
   End With
   End Sub
 
 
 
#28
19.11.2015 15:59:13
sv2013,Код суммирует все поддоны вместе, а нужно чтоб артикула не пересекались между поддонами.
 
 
 
#29
19.11.2015 19:35:32
Юрий М,Опишу процедуру работы с файлом:
Паллеты накапливаются - процедурой добавленя на паллеты товара (артикула).
На разных паллетах может находится одинаковые артикула.
Нужно сделать так, чтоб при добавлении в паллету с товаром артикула, которые уже есть в данной паллете артикула не задваивались, а суммировался учёт артикула.
Но чтоб суммировался только учет в данной паллете, но не по всем паллетам.
Допустим:

Товарный запас "Нон фуд"
№АртикулНазваниеЕд.  
    изм.		УчётШтрихкодКол-во   выставленого№   Паллеты
1498722Плавки мужские Same   game в ассортиментешт82900055779013 1
2498722Плавки мужские Same   game в ассортиментешт152900055779013 1
3498722Плавки мужские Same   game в ассортиментешт252900055779013 5
4498722Плавки мужские Same   game в ассортиментешт152900055779013 5
Нужно чтоб получилось при нажатии кнопки:
Нужно, чтоб данная процедура происходила в том же листе в которой ведётся учёт "Накопительный".
Ещё раз подгружаю файл копия моего рабочего файла. Структура ввида не должна изменятся.
Помогите пожалуйста, не получается у меня решить данную задачку самому.

Товарный запас "Нон фуд"
№АртикулНазваниеЕд.  
    изм.		УчётШтрихкодКол-во   выставленого№   Паллеты
1498722Плавки мужские Same   game в ассортиментешт232900055779013 1
2498722Плавки мужские Same   game в ассортиментешт402900055779013 5
 
 
 
#30
19.11.2015 20:39:41
Ещё раз спрошу - где должна располагаться итоговая таблица? То, что на первом листе, я понял. Где её позиция на листе - правее исходной?
И почему в первом файле строки с данными начинаются со второй строки, а в реальности, оказывается, что с пятой?
Из Правил:
Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 100 Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх