Страницы: 1
RSS
Кол-во повторяющихся значений в ячейках таблицы
 
Добрый день,

Прошу помочь с подсчетом повторяющихся значений в столбце С (Наименование товара). Т.е. необходимо понять сколько раз закупался каждый товар. Для примера взял сокращенный вариант таблицы. На самом деле таблица огромная, ассортимент незнакомый, хочу увидеть ТОП-5 самых закупаемых товаров.

Заранее благодарю за подсказку.
Изменено: Artee1986 - 18.09.2018 11:27:58
 
Artee1986,
Код
Sub Art()
Dim x, y
  With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For Each x In Range("C4", Cells(Rows.Count, "C").End(xlUp)).Value2
      For Each y In Split(x, ";")
        y = Split(Trim(y), , 3)(2)
        .Item(y) = .Item(y) + 1
      Next
    Next
    Worksheets.Add , ActiveSheet
    Range("A1").Resize(.Count).Value = WorksheetFunction.Transpose(.keys)
    Range("B1").Resize(.Count).Value = WorksheetFunction.Transpose(.items)
  End With
End Sub
Потом отсортируйте (можно записать команду макрорекордером и добавить в код)

Возможно, следует удалить текст в скобках в конце названия, чтобы такие названия считались за одно
headset Philips   SHM19004
headset Philips SHM1900 (black)1
Изменено: Казанский - 13.09.2018 15:19:17
 
Ух ты! Спасибо. знал бы я еще как этим пользоваться:)
А попроще для "чайников" есть вариант?
Изменено: Artee1986 - 14.09.2018 09:48:03
 
а сводной не подойдет? названия заковыристые - один и тот же продукт мб отличатся в написании?  
В жизни нет ничего невозможного! Есть только недостаток знаний и умений.
 
О! Получилось. Погуглил и научился создавать макросы. Чудо:)
Изменено: Artee1986 - 14.09.2018 09:48:21
 
Цитата
Александр написал:
а сводной не подойдет? названия заковыристые - один и тот же продукт мб отличатся в написании?
Может и подойдет, научите как:) У меня уже была мысль - может посчитать сколько каждое слово встречается в списке? Ну например - monitor - 2 раза, the - 15 раз, headset - 6 раз и т.д. А потом отфильтровать по ключевым словам в названии...
 
Казанский,

Подскажите, а как этот код к моей исходной таблице применить? На Примере понятно, вы всё прописали, а какие параметры надо заменить, чтобы этот код к другой аналогичной таблице применился?
 
Попробовал применить этот код к другой таблице, там строк в 100 раз больше, пишет ошибку subscript out of range  вот здесь  y = Split(Trim(y), , 3)(2)
Изменено: Artee1986 - 14.09.2018 09:48:46
 
Artee1986, эта ошибка не связана с размером таблицы. Она возникает, если описание товара содержит менее 3 слов, т.е. не начинается с "1 pc " или "n pcs ". Возможно, в описании товара содержится символ ";".
Макрос в такой модификации остановится и выделит ячейку, на которой происходит ошибка. Соберите файл из таких ячеек и выложите - посмотрим, как лучше сделать.
Код
Sub Art()
Dim x, y, i&
  On Error GoTo 1
  With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For Each x In Range("C4", Cells(Rows.Count, "C").End(xlUp)).Value2
      i = i + 1
      For Each y In Split(x, ";")
        y = Split(WorksheetFunction.Trim(y), , 3)(2)
        .Item(y) = .Item(y) + 1
      Next
    Next
    Worksheets.Add , ActiveSheet
    Range("A1").Resize(.Count).Value = WorksheetFunction.Transpose(.keys)
    Range("B1").Resize(.Count).Value = WorksheetFunction.Transpose(.items)
  End With
  Exit Sub
  
1 Cells(i + 3, "C").Select
  MsgBox "y: " & y, vbCritical, "На этой ячейке ошибка"
End Sub
Изменено: Казанский - 14.09.2018 12:17:31
 
Artee1986, прекратите мучить кнопку цитирования - она не для ответа!
 
И не просто прекратите - вернитесь и приведите свои сообщения в порядок.
Помощь скрыта, прекращена до устранения замечания.
 
Замечание утранил. Теперь-то можно получить ответ на вопрос?
 
Скрытое сообщение (#9) отображается.
 
Казанский,

Я прикрепил всю таблицу в оригинале как она есть.
Изменено: Artee1986 - 18.09.2018 09:45:42
 
количество повторяющихся значений = количество всех значений - количество возможных значений
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Artee1986, усовершенствовал распознавание количества товара. Все варианты учесть не удалось, но бОльшая часть распознается.
Код
Sub Art()
Dim x, y, re As Object, i&, s$, n&, v()
  Set re = CreateObject("vbscript.regexp")
  re.ignorecase = True
  re.Pattern = " ?-? ?(\d{1,4})( |" & vbTab & ")?(pc|piece|qty)s?\.?"
  With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    v = Range("C4", Cells(Rows.Count, "C").End(xlUp)).Value2
    ReDim d&(1 To UBound(v) * 10, 1 To 2)
    For Each x In v
      For Each y In Split(x, ";")
        s = WorksheetFunction.Trim(y)
        If Len(s) Then
          With re.Execute(s)
            If .Count Then
              n = .Item(0).submatches(0)
              s = Trim$(re.Replace(s, ""))
            Else: n = 1
            End If
          End With
          If .exists(s) Then i = .Item(s) Else i = .Count + 1: .Item(s) = i
          d(i, 1) = d(i, 1) + 1
          d(i, 2) = d(i, 2) + n
        End If
      Next
    Next
    Worksheets.Add , ActiveSheet
    Range("A1:C1").Value = Split("Наименование|Число закупок|Кол-во (оценочно!)", "|")
    Range("A2").Resize(.Count).Value = WorksheetFunction.Transpose(.keys)
    Range("B2:C2").Resize(.Count).Value = d
    Columns(1).ColumnWidth = 90
    Columns("B:C").AutoFit
  End With
End Sub
 
Казанский,

Огромное спасибо! Вы сэкономили мне часов 10.
 

Казанский,

Только один момент... Что означают цифры в двух столбцах? Картинку получившейся таблицы прилагаю.

 
См. строку 28 в коде. При копировании с сайта должна быть включена русская раскладка. Если не поможет, исправьте в VBA.
 
Казанский,

Переключение раскладок не помогло, дописал сам ручками в VBA, но тоже не читается (скриншот прилагаю). Да ладно, не суть важно, главное, что цифры на свои места стали и понятно что они значат.
Спасибо за помощь!
Страницы: 1
Наверх