Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос группировки ошибки в написании - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Макрос группировки ошибки в написании
specialist_87 Дата: Четверг, 12.02.2015, 09:43 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
помогите написать макрос группировки. Должно группировать одинаковые ИНН и по ним выводить сумму
К сообщению приложен файл: __.xls (72.0 Kb)
 
Ответить
Сообщениепомогите написать макрос группировки. Должно группировать одинаковые ИНН и по ним выводить сумму

Автор - specialist_87
Дата добавления - 12.02.2015 в 09:43
krosav4ig Дата: Четверг, 12.02.2015, 12:39 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
в файл добавил автотаблицу и именованный диапазон
[vba]
Код
Sub qwe()
     Dim cn: Set cn = CreateObject("ADODB.Connection")
     Dim rs: Set rs = CreateObject("ADODB.Recordset")
     Dim prop: Set prop = cn.Properties
     cn.Provider = "Microsoft.Jet.OLEDB.4.0"
     prop("data source") = ThisWorkbook.FullName
     prop("Extended Properties") = "Excel 8.0;HDR=No;"
     cn.Open
     rs.Open "select f9, sum(f12), sum(F13)  from [за месяц$" & [данные].Address(0, 0) & "] group by F9", cn, 3, 3
     With Sheets("за месяц по нн").ListObjects("Таблица1")
         On Error Resume Next
         .DataBodyRange.Delete
         .ShowTotals = False
         .Range.Cells(2, 2).CopyFromRecordset rs
         .ShowTotals = True
     End With
     rs.Close: cn.Close: Set cn = Nothing: Set rs = Nothing
End Sub
[/vba]
К сообщению приложен файл: -1-.xls (76.5 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 12.02.2015, 12:42
 
Ответить
Сообщениев файл добавил автотаблицу и именованный диапазон
[vba]
Код
Sub qwe()
     Dim cn: Set cn = CreateObject("ADODB.Connection")
     Dim rs: Set rs = CreateObject("ADODB.Recordset")
     Dim prop: Set prop = cn.Properties
     cn.Provider = "Microsoft.Jet.OLEDB.4.0"
     prop("data source") = ThisWorkbook.FullName
     prop("Extended Properties") = "Excel 8.0;HDR=No;"
     cn.Open
     rs.Open "select f9, sum(f12), sum(F13)  from [за месяц$" & [данные].Address(0, 0) & "] group by F9", cn, 3, 3
     With Sheets("за месяц по нн").ListObjects("Таблица1")
         On Error Resume Next
         .DataBodyRange.Delete
         .ShowTotals = False
         .Range.Cells(2, 2).CopyFromRecordset rs
         .ShowTotals = True
     End With
     rs.Close: cn.Close: Set cn = Nothing: Set rs = Nothing
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 12.02.2015 в 12:39
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!