Excel, макрос.

[Borisenkoff]

Друзья, кто разбирается в макросах Экселя, помогите, пожалуйста, любителю)))

 

Есть папка, в которой находится 64 экселевских файла с одинаковыми (по формату) таблицами.

Таблица содержит сведения об операциях по кассе (счета и суммы). Мне нужно вытащить количество операций по заданному счёту, которые меньше или равны 30 тысячам.

 

Сейчас я делаю это через автофильтр, заходя в каждый файл и смотрю, какое количество записей найдено.

 

Минимум, мне нужен скрипт, отвечающий на вопрос:

какое количество записей содержит таблица, если в колонке А есть такой-то счет, а в колонке В при этом сумма меньше или равна 30 тысячам.

 

Имея такой скрипт я смогу написать макрос, но он будет, во-первых, большим, а. во-вторых, он будет завязан на именах файлов. Т.е. мне нельзя будет использовать файлы с таблицами с любыми именами, только с определёнными. Поэтому...

 

максимум, нужен скрипт, который будет открывать файлы Эксель из указанной папки, независимо от того, как они называются. Т.е. он должен как бы перебирать их: открыл, взял данные, вставил их в нужное место (в др экселевский файл), закрыл. И так со всеми файлами.

 

Сумбурно наверно излагаю, но, как умею. Может ли кто помочь?))

[Borisenkoff]

Чьёрт побьери! (с)

Думал, что в оффтопике пишу, перекиньте, пожалуйста.

[Borisenkoff]

Слушайте, я один такой до фига умный в этой ветке?))))

[Hendalph]

КМК, тут не обойтись без приложения стороннего... написанного на чем угодно... ибо первой в голову пришла мысль тоже с перебором имен файлов, больше идей нет =(

[Sab252]

Лучше всётаки спрашивать где-то здесь Excel форум

[Ифыч]

Если все еще актуально, то могу написать софтину, которая все это буит делать. Желательно в личку:))

[Borisenkoff]

Hendalph, Ифыч, не не, с софтиной заморачиваться для меня слишком сложно будет. Я хочу своими силами справиться.

 

Скажите хотя бы, каким скриптом выбрать, сколько в колонке сумм меньше или равной 30 тысячам?

[Ифыч]

Я в Excel'е не силен. Могу только подсказать, что можно воспользоваться функцией БСЧЁТ. А вообще почитай хелп к Excel'ю, там много всего полезного.:)

[IIuTa4oK]

Borisenkoff,

Можете примерчик скинуть на iiuta4ok (псина) rambler (тычка) ru

Чтобы понятно было, какова структура файла.

[Borisenkoff]

IIuTa4oK,

С почтой у меня мороки много.

 

Из столбцов G и H мне нужно выбрать, сколько было операцйи по счету 30232810800002000001 на сумму меньше или равно 30 000.

И так в 64 файлах.

[IIuTa4oK]

Borisenkoff,

 

Сегодня вечером или завтра утром выложу вам код.

[САНЕК~]

Все ответы ЗДЕСЬ!!!

[IIuTa4oK]

Borisenkoff,

 

В файлах с данными один лист или несколько? Как они называются?

 

У вас на компе разделитель точка или запятая?

 

 

Попробуйте:

 

Sub Выборка()
Application.ScreenUpdating = False

Set vyb = ActiveWorkbook.ActiveSheet
ns = 1
vyb.Cells(1, 1) = "Название файла"
vyb.Cells(1, 2) = "Дата операции"
vyb.Cells(1, 3) = "Сумма"

' Переменные
Mask = "*.xls"    ' Маска файлов для отбора
Path = "C:\Выписки\"    'Путь к файлам с выписками

With Application.FileSearch
       .NewSearch
       .LookIn = Path
       .Filename = Mask
       .SearchSubFolders = False
       If .Execute() > 0 Then
       For k = 1 To .FoundFiles.Count
           Workbooks.Open Filename:=.FoundFiles(k), UpdateLinks:=0
           dan = ActiveWorkbook.Name
           Set dan_l = ActiveWorkbook.ActiveSheet


           For i = 1 To ActiveCell.SpecialCells(xlLastCell).Row

               If dan_l.Cells(i, 7).Value = "30232810800002000001" And dan_l.Cells(i, 8).Value <= 30000 Then
                   ns = ns + 1
                   vyb.Cells(ns, 1).Value = dan  'Название файла отчета
                   vyb.Cells(ns, 2).Value = dan_l.Cells(i, 3).Value  'Дата операции
                   vyb.Cells(ns, 3).Value = dan_l.Cells(i, 8).Value  'Сумма

               End If
           Next i

           Workbooks(dan).Close (0)

       Next k
       End If
End With


Application.ScreenUpdating = True

End Sub

[Borisenkoff]

IIuTa4oK, круто)) Ничего не понимаю, сейчас попробую))

[Borisenkoff]

Отлично! Друг, ты мне так помог!!! Просто офигенно!)))

За 6 секунд инфа собралась! Просто чудо!)

 

Сейчас подредактирую мелочи и отлично будет!

If dan_l.Cells(i, 7).Value = "30232810800002000001" And dan_l.Cells(i, 8).Value <= 30000 Thenns = ns + 1vyb.Cells(ns, 1).Value = dan 'Название файла отчетаvyb.Cells(ns, 2).Value = dan_l.Cells(i, 3).Value 'Дата операцииvyb.Cells(ns, 3).Value = dan_l.Cells(i, 8).Value 'Сумма

Как сделать, чтобы вместо названия файла отчета притягивалось название отделения? Оно в каждом файле в ячейке D5.

И дата операции не нужна, пусть будет просто название отделения и сумму операции. Я допишу, чтобы он сводную таблицу делал и будет просто фантастика!)

[IIuTa4oK]

Отлично! Друг, ты мне так помог!!! Просто офигенно!)))

За 6 секунд инфа собралась! Просто чудо!)

 

Сейчас подредактирую мелочи и отлично будет!

 

Как сделать, чтобы вместо названия файла отчета притягивалось название отделения? Оно в каждом файле в ячейке D5.

И дата операции не нужна, пусть будет просто название отделения и сумму операции. Я допишу, чтобы он сводную таблицу делал и будет просто фантастика!)

 

 

Да не за что :rolleyes:

 

Тогда так:

 

Sub Выборка()
Application.ScreenUpdating = False

Set vyb = ActiveWorkbook.ActiveSheet
ns = 1
vyb.Cells(1, 1) = "Название отделения"
vyb.Cells(1, 2) = "Сумма операции"

' Переменные
Mask = "*.xls"    ' Маска файлов для отбора
Path = "C:\Выписки\"    'Путь к файлам с выписками

With Application.FileSearch
       .NewSearch
       .LookIn = Path
       .Filename = Mask
       .SearchSubFolders = False
       If .Execute() > 0 Then
       For k = 1 To .FoundFiles.Count
           Workbooks.Open Filename:=.FoundFiles(k), UpdateLinks:=0
           dan = ActiveWorkbook.Name
           Set dan_l = ActiveWorkbook.ActiveSheet


           For i = 1 To ActiveCell.SpecialCells(xlLastCell).Row

               If dan_l.Cells(i, 7).Value = "30232810800002000001" And dan_l.Cells(i, 8).Value <= 30000 Then
                   ns = ns + 1
                   vyb.Cells(ns, 1).Value = dan_l.Cells(5, 4).Value  'Название отделения
                   vyb.Cells(ns, 2).Value = dan_l.Cells(i, 8).Value  'Сумма

               End If
           Next i

           Workbooks(dan).Close (0)

       Next k
       End If
End With


Application.ScreenUpdating = True

End Sub

 

Макросы офиса - классная штука!

[Borisenkoff]

IIuTa4oK, шикааарно! Отлично работает! Спасибо большущее!!!

[IIuTa4oK]

IIuTa4oK, шикааарно! Отлично работает! Спасибо большущее!!!

 

Ну хорошо :rolleyes:

А точно все правильно работает?

Проверяли? А то мало ли..

[Borisenkoff]

IIuTa4oK, выборочно проверил - вроде всё сходится.