Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Создание единой системы расчета и сбора информации

Автор NoNseNse, 22.06.2011, 02:03

« назад - далее »

NoNseNse

Очень надеюсь на вашу помощь в поиске наиболее приемлемого подхода для реализации идеи.

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

Чтобы хотелось в итоге получить:

Филиалы формируют файлы с исходными данными и с помощью макроса пополняют базу исходных данных (на базе Excel если это возможно) в Центральном Офисе (далее ЦО) причем если исходные данные изменились они должны быть перезаписаны.
Этот сводный файл (далее сводный файл исходных данных) имеет вид:
строка 1, строка 2, строка N (до нескольких тысяч)
столбцы: Проект 1, населенный пункт, филиал, данные 1, данные 2, данные N

Другой файл (расчетный файл) в ЦО делает расчет по определенному (довольно часто кардинально меняющемуся) алгоритму вычислений и выводит часть данных в сводный файл итоговых данных.

Подскажите пожалуйста каким образом можно реализовать эту идею?

=======================================================================

На текущий момент существует 254 проекта (по каждому проекту есть 2 файла: один с алгоритмом расчета, а второй с частью исходных данных другая часть берется из одного из листов файла в котором формируется итоговый сводный отчет по вычислениям по каждому проекту). Проблема заключается в том что весь это ворох файлов (пусть и нормально структурированных) постоянно путешествует с одного компьютера на другой и постоянно дополняется новыми проектами и и/или изменяются исходные данные по уже заведенным проектам. В файлах расчета активно используется стандартная функция ВПР причем диапазон поиска берется из листа находящегося в другом файле и после нескольких смен пользователей данные в файлах расчета перестали обновляться (ссылка на диапазон поиска становится не актуальной/ не правильной). Все это жутко не удобно, так как для формирования итогового сводного отчета приходится постоянно менять во всех файлах расчета и во всех ячейках этих файлов где используется ВПР путь к диапазону поиска.

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

Очень прошу помочь, так как существующий подход чрезвычайно ушербен! Для создания сводного отчета по всем проектам нужно сначала исправить "поплывшие" диапазоны поиска, затем открыть все файлы расчетов и исходных данных (всего их сейчас 350) и ждаааааааааааать пока все эти 254 файла расчета обновят исходные данные и произведут вычисления. С ужасом представляю, что будет когда этих проектов будет несколько тысяч.

Очень надеюсь на вашу помощь и совет.

sergo44441

что сказать? пример фАЙЛА И АЛГОРИТМА в студию))))
Не торопись, и все успеешь намного быстрее

NoNseNse

#2
После прочтения нескольких разделов форума появилось понимание как лучше это сделать   :D.
Понравился макрос позволяющий объединять данные с разных листов/файлов в один сводный http://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/
но с некоторыми отличиями:
1) макрос должен запускаться с кнопки, но в своей работе не должен использовать диалоговые окна, а должен быть абсолютно автономным (чтоб не было возможности допустить ошибку):
- количество листов и их название заранее известны;
- количество столбцов во всех листах одинаково (в примере столбцы А:М);
- количество строк разное (но сбор данных начинается со второй строки - чтоб не попадали заголовки в сводную входных данных);
- данные сводятся всегда на один и тот же лист начиная со второй строки, причем при каждом новом запуске макроса предыдущие данные полностью удаляются начиная со второй строки сводной таблицы входящих данных;
2) итогом работы макроса должна стать сводная таблица входных данных (в примере "Сводный вх.");
3) данные из сводной таблицы входных данных должны построчно (ячейки А2:М2) попадать на лист "Расчет" в соответствующие ячейки (B2:N2);
4) на листе расчет происходит расчет исходящих данных которые появляются в ячейках B3:N3 листа расчет;
5) после появления исходящих данных на листе "Расчет" макрос переносит их в сводную таблицу на лист "_сводные_ исх." построчно в следующую не заполненную строку.

Сейчас добросовестно борюсь с кодом, но так и не добился желаемых успехов (без комментариев очень сложно разобраться);
Option Explicit
Sub Consolidated_Range_of_Books_and_Sheets()
   Dim iBeginRange As Object, lCalc As Long
   Dim sRngAddress As String, oAwb As String, sCopyAddress As String, sSheetName As String
   Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
   Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
   On Error Resume Next
   Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                          "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                          vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
   If iBeginRange Is Nothing Then Exit Sub
   sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
   If sSheetName = "" Then sSheetName = "*"
   On Error GoTo 0
   If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
       avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
       If VarType(avFiles) = vbBoolean Then Exit Sub
       bPolyBooks = True
   Else
       avFiles = Array(ThisWorkbook.FullName)
   End If
   With Application
       lCalc = .Calculation
       .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
   End With
   ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
   Set wsDataSheet = ThisWorkbook.ActiveSheet
   For li = LBound(avFiles) To UBound(avFiles)
       If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
       oAwb = Dir(avFiles(li), vbDirectory)
       For Each wsSh In Workbooks(oAwb).Sheets
           If wsSh.Name Like sSheetName Then
               If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
               With wsSh
                   Select Case iBeginRange.Count
                   Case 1
                       lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                       iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                       sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                   Case Else
                       sCopyAddress = iBeginRange.Address
                       lLastrow = iBeginRange.Rows.Count
                       iLastColumn = iBeginRange.Columns.Count
                   End Select
                   lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                   sRngAddress = .Range(.Cells(lLastRowMyBook, 1), .Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                   .Range(sCopyAddress).Copy wsDataSheet.Range(sRngAddress)
               End With
           End If
NEXT_:
       Next wsSh
       If bPolyBooks Then Workbooks(oAwb).Close False
   Next li
   With Application
       .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
   End With
End Sub


Люди добрые помогите!   :-\

NoNseNse

Ну или хотя бы подскажите как заставить макрос не останавливаться после выполнения одной операции с А2 -> преобразование (получение диапазона значений) -> А2 (вставка диапазона значений), а продолжал выполнять однотипные операции и для ячеек A3, A4 и т.п. пока не закончатся значения?

Sub Макрос1()
'
' Макрос1 Макрос
'

'
   Sheets("Sheet3").Select
   Range("A2").Select
   Selection.Copy
   Sheets("ТЭО").Select
   Range("A131").Select
   ActiveSheet.Paste
   Range("A134:I134").Select
   Application.CutCopyMode = False
   Selection.Copy
   Sheets("Отчет").Select
   Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False

sergo44441

у вас всего 254 проекта, по всем надо такое же сделать, или выводить данные надо в другой файл, где и будет находиться макрос, отвечающий за это?
Не торопись, и все успеешь намного быстрее

NoNseNse

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

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

Теперь нужны 3 макроса:
1) который может собрать данные с нескольких однотипных листов (данные из разных региональных отделений) отличающиеся только количеством строк и собрать их в сводном листе исходных данных (в принципе это легко можно сделать и в ручную, но раз уж поставленная цель научится разбираться в макросах и есть похожие макросы значит нужно сделать);
2) макрос который элементарно копирует строчку из исходных данных в расчетный лист, а оттуда забирает строчку с итогами расчета и копирует её на лист с данными расчета и так по очереди по всем строчками из листа с исходными данными. Причем данный макрос должен позволять переносить строчки после обработки фильтрами;
3) и самый простой макрос которым можно перенести одну выбранную строку (по первой ячейке) в расчетный лист и который перенесет данные расчета в лист с итогами расчетов.


GWolf

Добрый день!

Давайте по порядку. Разбираться так разбираться.

1) Опрос листов со сбором хранящейся на них информации.
Простая вообщем-то задача. Но при четком ответе на следующие вопросы:
1.1) Где будут хранится опрашиваемые листы:
              а) в отдельных файлах, сгруппированные в папку с заранее известным названием. При таком варианте, вообщем-то неважно становится имя конкретного опрашиваемого файла. Макрос откроет ВСЕ файлы известной папки и в скопированных блоках данных может пометить, откуда данные взяты;
              б) пользователь сам, вручную, вствляет набор опрашиваемых листов в книгу с макросом. Этот путь может показаться более простым. Предполагая одновременный контроль за полнотой информации. Например: - все или нет листы присутствуют.
      На самом деле сценарий п. 1.1а более универсален. А если в книгу с макросом добавить "Служебный лист" - это такой же лист Excel, но в его ячейках пользователь будет иметь возможность ввода перечьня обрабатываемых листов. Ну, что то типа справочника, то макрос считав в начале обработки этот список и в ходе ее сравнивая его с опрашиваемыми листами, может сделать автоматическое заключение по полноте информации. Т.о. будет решена и задача п. 1.1б, но в АВТОМАТИЧЕСКОМ режиме.


Путей к вершине - множество. Этот один из многих!

GWolf

Не знаю, поможет ли Вам:

Sub opros()
    Dim arrNmWS() As String
   
    With ThisWorkbook 'все что будем делать, будем делать в текущей рабочей книге = Start
       
        'список имен листов запишем в ОДНОМЕРНЫЙ массив = Start
        arrNmWS = Split("Лист1 Лист2 Лист3", " ", -1, vbTextCompare)
        'список имен листов запишем в ОДНОМЕРНЫЙ массив = Stop
       
        'теперь идем по набору листов = Start
        i = 0 'счетчику шагов, присваиваем начальное значение
        'перемещаемся по массиву имен = Start
        For i = LBound(arrNmWS) To UBound(arrNmWS)
            '!!! Точка перед Worksheets ... означает, что мы работаем в границах обозначенных в With ... End With
            'на листе с именем находящимся в массиве под номером i, в _
             ячейке "C2" (координаты: 2 - номер строки; 3 - номер столбца) _
             вписываем имя опрашиваемого листа: arrNmWS(i)
           
            .Worksheets(arrNmWS(i)).Cells(2, 3) = arrNmWS(i)
        Next i
        'перемещаемся по массиву имен = Start
        'теперь идем по набору листов = Stop
   
    End With 'все что будем делать, будем делать в текущей рабочей книге = Stop
   
    'очистка переменных = Start
    Erase arrNmWS
    'очистка переменных = Stop
End Sub

Комментарии писал специально т.о., что бы они ограничивали происходящий процесс. Т.е. их читать следует так: Если коммент имеет на конце = Start, то ищите ниже такой же с = Stop. Если коммент не имеет = Start, то он относится к конкретной строке ниже либо левее коммента.
Путей к вершине - множество. Этот один из многих!