|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
07.10.2014, 15:52 | #1 |
Регистрация: 07.10.2014
Сообщений: 5
|
Расчет количества по уникальным значениям
Всем привет. Думаю что уже не раз такое всплывало но у мен что то не получилось собрать общей картинки((
Нужен макрос который из лист1 на лист 2 поделит все строки по Категориям опираясь на значения колнки Е. И на лист 3 отдельно все уникальные значения с Лист1 колонки Е и рядом их количество. Вот такое я смог нарыть и немного поправить под свой вариант. Но что добавить Cells(k + 3, 8) = ? не знаю. И макрос под Лист 3 вообще не выходит. Значения перетащил сделал фильтр на уникальность и Рядом вставляю формулу Счётесли () но он ничего не считает((( Заранее огромное спасибо за помощь) Sub Main() Dim i As Long, j As Long, k As Long, x As New Collection, y As Range, a() Application.ScreenUpdating = False Set y = Range([A1], Cells(Cells(Rows.Count, 2).End(xlUp).Row, "M")) With Sheets(" Лист2") .Cells.Delete: [A:M].Copy: .[A1].PasteSpecial Paste:=xlPasteColumnWidths a = Range([F2], Cells(Rows.Count, 6).End(xlUp)).Value: [A:M].AutoFilter: j = 4 For i = 1 To UBound(a, 1) If a(i, 1) <> "" Then On Error Resume Next: x.Add a(i, 1), CStr(a(i, 1)) If Err = 0 Then [A:L].AutoFilter Field:=6, Criteria1:=a(i, 1) y.SpecialCells(xlCellTypeVisible).C opy .Cells(j, 1) .Cells(j - 2, 2) = a(i, 1): .Cells(j - 2, 2).Font.Bold = True k = .Cells(Rows.Count, 2).End(xlUp).Row .Cells(k + 3, 8) = .Cells(k + 3, 7) = "Количество": .[G:G].ColumnWidth = 11 With .Range(.Cells(k + 2, 7), .Cells(k + 3, 9)) .HorizontalAlignment = xlCenter .Font.Bold = True .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyl e = xlContinuous .Borders(xlInsideHorizontal).LineSt yle = xlContinuous End With j = .Cells(Rows.Count, 8).End(xlUp).Row + 5 Else: On Error GoTo 0 End If End If Next [A:M].AutoFilter: Application.Goto Reference:=.[A1] End With End Sub |
07.10.2014, 17:50 | #2 |
Форумчанин
Регистрация: 21.10.2012
Сообщений: 208
|
В файле ручками нарисуйте, что надо.
|
08.10.2014, 07:59 | #3 |
Регистрация: 07.10.2014
Сообщений: 5
|
Приожил файл сделанный по макросы из первого сообщения.
И вручную добил регионы и значения количества (их тоже надо поделить по регионам и общее) На лист количество выписал значения и количество. |
08.10.2014, 13:03 | #4 |
Форумчанин
Регистрация: 21.10.2012
Сообщений: 208
|
С областями не заморачивался, долго это и нудно.
|
08.10.2014, 14:21 | #5 |
Регистрация: 07.10.2014
Сообщений: 5
|
Спасибо огромное.
Но пока не потестил Set sd = CreateObject("Scripting.Dictionary" ) выдает ошибку 429 |
09.10.2014, 17:57 | #6 |
Форумчанин
Регистрация: 21.10.2012
Сообщений: 208
|
Странно, на 2003 и 2010 ошибок нет и системы win7x64, win8x32.
|
10.10.2014, 10:37 | #7 |
Регистрация: 07.10.2014
Сообщений: 5
|
У меня Excel for Mac 2011)))
|
10.10.2014, 11:26 | #8 |
Форумчанин
Регистрация: 21.10.2012
Сообщений: 208
|
В словарь собирались уникальные номера, надо заменить его какой-нибудь другой приблудой, лишь бы собрать циферки а дальше их перебрать.
|
10.10.2014, 13:13 | #9 |
Регистрация: 07.10.2014
Сообщений: 5
|
Поможете заменить)) а то я как то не силен в этом((
Еще раз огромное спасибо. |
Опции темы | Поиск в этой теме |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Последовательность видеоимпульсов (расчет количества совпадений) | pavel1122 | C++ Builder | 2 | 06.07.2013 07:13 |
Расчет количества слов в Access | o600000 | Microsoft Office Access | 4 | 06.11.2012 17:38 |
Расчет количества пикселей для отображения записи | Lokos | Общие вопросы Delphi | 11 | 07.04.2011 08:33 |
Firebird. Расчет количества. | artemavd | БД в Delphi | 40 | 24.11.2009 06:05 |