Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Копия результатов автофильтра в новый файл Добавлено: 27.03.09 09:32  

Автор вопроса:  Joker
Приходит файл детализации по межгороду. После обработки появляется столбец с информацией о том к какому департаменту принадлежит телефон. На один департамент приходится несколько телефонов. Нужно сделать рассылку по департаментам. С помощью автофильтра в макросе я отфильтровываю нужный департамент со всеми телефлнами. А вот результат с помощью макроса скопировать не получается. ПОМОГИТЕ КТО МОЖЕТ!!!!

Ответить

  Ответы Всего ответов: 5  

Номер ответа: 1
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #1 Добавлено: 27.03.09 14:42
Как-то уже был вопрос такой, не могу найти ссылку.
Но смысл был такой:
  1.   'установка фильтра
  2.   Worksheets("Database").Activate
  3.   Selection.AutoFilter Field:=14, Criteria1:="=+"  'устанавливаем фильтр на 14 поле, критерий =+
  4.   Set r = ActiveSheet.AutoFilter.Range
  5.   c = r.CurrentRegion.Columns(15).SpecialCells(xlVisible).Count - 1  'получаем количество видимых строк
  6.   Range("O20").Value = c

Еще вот этот отрывок может помочь:
Dim r As Range
Set r = ActiveSheet.AutoFilter.Range
a = r.CurrentRegion.Columns(1).SpecialCells(xlVisible).Address
c = r.CurrentRegion.Columns(1).SpecialCells(xlVisible).Count - 1
a = "," & a
Dim MyArr() As String
MyArr = Split(a, ",$A$";)

в итоге в массиве MyArr номера строк. Останется только потом преобразовать их в числовые значения (Val)

Автор Executioner :)

Ответить

Номер ответа: 2
Автор ответа:
 mai



Вопросов: 0
Ответов: 24
  Профиль | | #2 Добавлено: 28.03.09 18:01
  1. Set tbl = Sheets("Лист1").AutoFilter.Range
  2. tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
  3.     tbl.Columns.Count).Copy Destination:=(Sheets("Лист2").Cells(5, 5))

Ответить

Номер ответа: 3
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #3 		Добавлено: 28.03.09 18:45
Да просто выделить всю большую портянку (содержимое автофильтра), отсортировать по определенной колонке, дать команду "выделить видимые ячейки" и копировать-вставлять куда требуется.

Можно сделать красивее: один проход цикла и в цикле вставлять данные построчно в разные книги, которые будут вновь создаваться по мере того, как встречаются новые названия департаментов.

Ответить

Номер ответа: 4
Автор ответа:
 mai



Вопросов: 0
Ответов: 24
  Профиль | | #4 Добавлено: 28.03.09 19:39
Мой код копирует отфильтрованные автофильтром строки с Лист1 на Лист2 начиная с ячейки Е5.

Ответить

Номер ответа: 5
Автор ответа:
 mai



Вопросов: 0
Ответов: 24
  Профиль | | #5 Добавлено: 30.03.09 14:00
То, что предлагает mc-black

  1. Sub SendingOut()
  2. Dim PathWb As String, rng As Range, Wb As Workbook
  3. 'отключаем обновление экрана
  4.     Application.ScreenUpdating = False
  5. 'путь к каталогу с файлами для рассылки
  6.     PathWb = ThisWorkbook.Path & "\Рассылка\"
  7. 'если каталог не существует, создаем его
  8.     If Dir(PathWb, vbDirectory) = "" Then MkDir (PathWb)
  9. 'если в каталоге есть файлы, удаляем их
  10.     If Dir(PathWb) <> "" Then Kill PathWb & "*"
  11. 'берем в переменную общий список
  12. 'предпологается, что список находится на листе Лист1
  13. 'и начинается с ячейки А1
  14. 'при необходимости измените
  15.     Set rng = ThisWorkbook.Sheets("Лист1").Range("A1").CurrentRegion
  16. 'отфильтровываем уникальные наименования департаментов
  17. 'предологается, что они находятся в первом столбце таблицы
  18. '(может не повпадать с номерами столбцов рабочего листа)
  19.     rng.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  20. 'в цикле проходим по выделенным областям ячеек
  21.     For Each area In rng.Columns(1).Rows.SpecialCells(xlCellTypeVisible).Areas
  22. 'в цикле проходим каждую ячейку области
  23.         For Each cel In area
  24. 'если значение ячейки <> заголовку столбца
  25.             If cel.Value <> "департамент" Then
  26. 'создаем новую книгу с одним листом
  27.                 With Workbooks.Add(xlWBATWorksheet)
  28. 'отфильтровываем департамент
  29.                 rng.AutoFilter field:=1, Criteria1:=cel.Value
  30. 'результат фильтрации копируем в новую книгу, начиная с ячейки 5,1 (А5)
  31.                 rng.SpecialCells(xlCellTypeVisible).Copy _
  32.                 Destination:=.ActiveSheet.Cells(5, 1)
  33. 'в новой книге подгоняем ширину столбцов под содержимое
  34.                 .ActiveSheet.Columns.AutoFit
  35. 'пишем шапку документа
  36.                 .ActiveSheet.Cells(1, 2).Value = "Департамент " & cel.Value
  37.                 .ActiveSheet.Cells(2, 2).Value _
  38.                 = "исходящие тефонные звонки  за такой-то месяц"
  39. 'сохраняем новую книгу в каталоге Рассылка с именем наименования департамента
  40.                 .SaveAs (PathWb & Left(cel.Value, 5))
  41. 'и закрываем ее
  42.                 .Close
  43.                 End With
  44.             End If
  45.         Next
  46.     Next
  47. 'снимаем автофильтр
  48.     ThisWorkbook.Sheets("Лист1").AutoFilterMode = False
  49. 'включаем обновление экрана
  50.     Application.ScreenUpdating = True
  51. End Sub

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам