Получение данных из ячеек другого файла

Автор almaster13, 20 марта 2023, 16:55

0 Пользователи и 1 гость просматривают эту тему.

almaster13

В Экселе был файл, который с помощью макроса собирал данные из суточных файлов данных и переносил в заданные ячейки файла, где собирались данные за год. Можно было подгрузить данные как за определенное число, так и за диапазон чисел.
К сожалению макрос писал не я, к тому же пришлось перейти на Либре Кальк.
Попытался создать простой макрос, который берет данные из ячеек суточной сводки и переносит в файл (запись макроса). Если запускать макрос через меню Сервис-Макросы-Управление макросами... , то данные выгружаются верно, но при попытке создать кнопку в ячейке S1 и назначении ей макроса, данные в ячейки вставляются неверные. Причину понять не удалось. Прошу помочь разобраться!
Хотелось бы также услышать совет, как сделать макрос проще, ведь не будешь же делать 365 кнопок и столько же макросов для подгрузки всех значений за год?

economist

Рядом похожая задача. Для сотен и тысяч файлов м.б. лучше читать быстрыми способами:

https://forumooo.ru/index.php?topic=7964.msg64917#msg64917

В #5 - код для быстрой загрузки из всех csv/xls/ods файлов из папки.
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

economist

Плохо когда форму "на посмотреть" (суточную) пытаются собрать макросами в "свод" (по-хорошему делают наоборот). Любое решение тут будет слишком часто "ломаться". Слишком "широкая таблица с переменным числом столбцов" - это нетривиальная задача даже для Python/Pandas (но я бы решал именно в них). 

Однако ваши таблицы "за сутки" заполняются по данным (БД). Архитектурно правильнее оттуда же заполнять и "свод". Почти все БД позволяют выполнить SQL-запрос и сохранить результат в TXT/CSV-файл (1 сутки - 1 длинная строка).   

Если все это невозможно (не верится, учитывая специфику) - стоит опробовать и самый простой путь, без загрузки и макросов, связями формул. Для этого нужно использовать =ДВССЫЛ() в которой сконструировать ссылку на каждый суточный файл. Т.е. в яч. B2 нужно получить формулой ссылку вида
=['file:///D:/Суточная сводка 01.01.2023.xlsx']rpt!B10
Как видим, переменная часть тут - "01.01.2023", вот ее нужно взять из столбца А в виде текста. Скопировать формулу на всю таблицу.

А затем остается "B10" заменить на нужные ячейки (с опорой что бригад 4 и число строк в суточных файлах всегда одинаково). На 365 строках тормозить будет, но старые "месяцы" можно перевставить как значения, тогда будет опять летать.
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

almaster13

Получать данные из базы данных не дают, только если их будет получать ПО (не электронные таблицы). Когда я попытался просто поставить связи на файлы, в Экселе все просто, прописал, при работе обновил получение данных, тех файлов, которых нет (срок не наступил а связи прописаны до конца года) приложение один раз ругнется и все. В Кальке столкнулся с тем, что если будут данные только на 1-е число января, то придется 364 раза нажать на ОК при выдаче сообщений, что отсутствуют данные на 02.01, 03.01 и т.д. Никакого терпения не хватит столько раз нажать ОК.

almaster13

А насколько сложно сделать макрос в Либре Кальк аналогичный макросу на VBA? Вот сам макрос:

Public Sub OkBt_Click() 'При нажатии ОК копируем среднесуточные нагрузки за выбранные дни
  Dim i, j, FromDateRow, UntilDateRow As Integer
  Dim y As Byte
  Dim z As Byte
  Dim Catalog, SutName, FileSutName As String
  Dim FromDate, UntilDate, CopyDay As Date
  Dim c As Range
   
  FromDate = FromD.Value & "." & FromM.Value & "." & FromY.Value    'начальная дата копирования
  UntilDate = UntilD.Value & "." & UntilM.Value & "." & UntilY.Value 'конечная дата копирования
  FromDate = CDate(FromDate)    ' не знаю зачем
  UntilDate = CDate(UntilDate)  ' но без этого не работает
 
  If FromDate <= UntilDate Then
    Application.ScreenUpdating = False
    Catalog = "F:\Суточная сводка\"   'каталог где лежат суточные сводки
 
    ' ищем номер начальной и конечной строки в которую будем копировать
    With ThisWorkbook.Worksheets(1)
      Set c = .Range("A1")
      FromDateRow = 0
     
      Do Until c.Value = FromDate
        FromDateRow = FromDateRow + 1
        Set c = .Range("A" & FromDateRow)
      Loop
     
      Set c = .Range("A" & FromDateRow - 1)
      UntilDateRow = FromDateRow - 1
   
      Do Until c.Value = UntilDate
        UntilDateRow = UntilDateRow + 1
        Set c = .Range("A" & UntilDateRow)
      Loop
    End With
   
    For i = FromDateRow To UntilDateRow Step 1
        SutName = "Суточная сводка " & ThisWorkbook.Worksheets(1).Range("A" & i).Value & ".xlsx"
        FileSutName = Catalog & SutName
        Workbooks.Open FileSutName, ReadOnly:=True
        Workbooks(SutName).Worksheets(1).Range("B10,B13,B16,B19").Copy
        ThisWorkbook.Worksheets(1).Range("B" & i).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Workbooks(SutName).Worksheets(1).Range("B22").Copy
        ThisWorkbook.Worksheets(1).Range("G" & i).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False
        Workbooks(SutName).Worksheets(1).Range("B80").Copy
        ThisWorkbook.Worksheets(1).Range("T" & i).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False
        z = 22
        For y = 10 To 19 Step 3
            Workbooks(SutName).Worksheets(1).Range("C" & y & ":D" & y).Copy
            If y > 10 Then z = z + 2
            ThisWorkbook.Worksheets(1).Cells(i, z).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False
        Next y
        Workbooks(SutName).Close
       
        For j = 2 To 5 Step 1
          ThisWorkbook.Worksheets(1).Cells(i, j).Value = _
          Round(ThisWorkbook.Worksheets(1).Cells(i, j).Value, 1)
        Next j
       
        ThisWorkbook.Worksheets(1).Range("G" & i).Value = _
          Round(ThisWorkbook.Worksheets(1).Range("G" & i).Value, 1)
    Next i
    Application.ScreenUpdating = True
  End If
 
  UserForm1.Hide
End Sub

Private Sub CanselBt_Click() 'Если нажать Отмена форма закроется
UserForm1.Hide
End Sub

Public Sub UserForm_Initialize()  'Действия, проводимые при инициализации формы
  Dim CurDate As Date
  Dim i As Integer
 
  CurDate = Date - 1  ' берем вчерашнюю дату
 
  'Заполняем КомбоБоксы номерами дней c 1 по 31
  For i = 1 To 31 Step 1
    FromD.AddItem i
    UntilD.AddItem i
  Next i
  FromD.Value = Day(CurDate)  ' день С
  UntilD.Value = Day(CurDate) ' день ПО
 
  'Заполняем КомбоБоксы месяцами
  For i = 1 To 12 Step 1
    FromM.AddItem i
    UntilM.AddItem i
  Next i
    FromM.Value = Month(CurDate)   ' месяц С
    UntilM.Value = Month(CurDate) ' месяц ПО
 
  'Заполняем КомбоБоксы годами
  For i = 2009 To 2020 Step 1
    FromY.AddItem i
    UntilY.AddItem i
  Next i
  FromY.Value = Year(CurDate) ' год С
  UntilY.Value = Year(CurDate)  ' год ПО
   
End Sub


economist

Цитата: almaster13 от 21 марта 2023, 09:20Получать данные из базы данных не дают, только если их будет получать ПО

IT-шники могут выгрузить вам CSV из БД, написав SELECT-запрос. С подобными правилами - это их обязанность.

Цитата: almaster13 от 21 марта 2023, 09:20если будут данные только на 1-е число января, то придется 364 раза нажать на ОК

Создайте пустых 365 XLS-файлов, ругаться вообще не будет.

Цитата: almaster13 от 21 марта 2023, 09:20А насколько сложно сделать макрос в Либре Кальк аналогичный макросу на VBA? Вот сам макрос:

Попробуйте вверху Basic модуля LibreOffice Calc добавить строку:
Option VBASupport 1
И выполните макрос. Не сработает все, что связано с формой и комбобоксами, скорее всего. И тут два пути:
1) отказаться от Формы/Диалога и сделать все в ячейках и списках проверки, переписать код (~4 часа) 
2) переписать Форму/Диалог на StarBasic и переписать код (~20-40 часов)


Опытный макро-кодер справится быстрее. Но проблема в том что у вас его нет, а внешним по приложенным файлам не все понятно.
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...