Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 07.10.2014, 15:52   #1
Alisher_ka
 
Регистрация: 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
Alisher_ka вне форума Ответить с цитированием
Старый 07.10.2014, 17:50   #2
kalbasiatka
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 208
По умолчанию

В файле ручками нарисуйте, что надо.
kalbasiatka вне форума Ответить с цитированием
Старый 08.10.2014, 07:59   #3
Alisher_ka
 
Регистрация: 07.10.2014
Сообщений: 5
По умолчанию

Приожил файл сделанный по макросы из первого сообщения.
И вручную добил регионы и значения количества (их тоже надо поделить по регионам и общее)

На лист количество выписал значения и количество.
Вложения
Тип файла: zip Книга2.zip (46.0 Кб, 9 просмотров)
Alisher_ka вне форума Ответить с цитированием
Старый 08.10.2014, 13:03   #4
kalbasiatka
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 208
По умолчанию

С областями не заморачивался, долго это и нудно.
Вложения
Тип файла: rar Книга2_1.rar (18.8 Кб, 24 просмотров)
kalbasiatka вне форума Ответить с цитированием
Старый 08.10.2014, 14:21   #5
Alisher_ka
 
Регистрация: 07.10.2014
Сообщений: 5
По умолчанию

Спасибо огромное.
Но пока не потестил

Set sd = CreateObject("Scripting.Dictionary" )

выдает ошибку 429
Alisher_ka вне форума Ответить с цитированием
Старый 09.10.2014, 17:57   #6
kalbasiatka
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 208
По умолчанию

Цитата:
Сообщение от Alisher_ka Посмотреть сообщение
выдает ошибку 429
Странно, на 2003 и 2010 ошибок нет и системы win7x64, win8x32.
kalbasiatka вне форума Ответить с цитированием
Старый 10.10.2014, 10:37   #7
Alisher_ka
 
Регистрация: 07.10.2014
Сообщений: 5
По умолчанию

У меня Excel for Mac 2011)))
Alisher_ka вне форума Ответить с цитированием
Старый 10.10.2014, 11:26   #8
kalbasiatka
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 208
По умолчанию

В словарь собирались уникальные номера, надо заменить его какой-нибудь другой приблудой, лишь бы собрать циферки а дальше их перебрать.
kalbasiatka вне форума Ответить с цитированием
Старый 10.10.2014, 13:13   #9
Alisher_ka
 
Регистрация: 07.10.2014
Сообщений: 5
По умолчанию

Поможете заменить)) а то я как то не силен в этом((

Еще раз огромное спасибо.
Alisher_ka вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Последовательность видеоимпульсов (расчет количества совпадений) 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