Ответы пользователя по тегу Excel
  • Как оптимизировать работу с файлами в Python?

    Или лучше в VBA погрузиться для решения подобных задач?

    VBA - однопоточный, расспаралелить не получится.

    но если только собрать названия листов, то странно большое время у Вас для такой задачи.
    Я тут на коленке набросал код на VBA, так он 200 файлов за 4 минуты обработал, и это без оптимизации кода (excel 32, win 10, 4ядра по 3ГГц).
    Можете запустить у себя, для этого открыть новую книгу, открыть редактор макросов, выбрать лист на котором будете работать и вставить следующий код (полной заменой)
    Код для сбора списка листов из всех книг директории
    Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                                 Optional ByVal SearchDeep As Long = 999) As Collection
        ' © EducatedFool  excelvba.ru/code/FilenamesCollection
        ' Получает в качестве параметра путь к папке FolderPath,
        ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
        ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
        ' Возвращает коллекцию, содержащую полные пути найденных файлов
        ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
    
        Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
        Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
        GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
        Set FSO = Nothing     ' очистка строки состояния Excel
    End Function
     
    Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                     ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
        ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
        ' перебор папок осуществляется в том случае, если SearchDeep > 1
        ' добавляет пути найденных файлов в коллекцию FileNamesColl
        On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
        If Not curfold Is Nothing Then    ' если удалось получить доступ к папке
    
            ' раскомментируйте эту строку для вывода пути к просматриваемой
            ' в текущий момент папке в строку состояния Excel
            ' Application.StatusBar = "Поиск в папке: " & FolderPath
    
            For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
                If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
            Next
            SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
            If SearchDeep Then    ' если надо искать глубже
                For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
                    GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
                Next
            End If
            Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
        End If
    End Function
    
    Sub LoopThroughFiles(ByVal sDirName As String, ByRef lRow As Long, ByVal sMask As String)
       On Error Resume Next
       Dim folder$, coll As Collection
       Dim EX As Excel.Application
       Dim wkb As Workbook
       Dim wks As Worksheet
       Dim file As Variant
       Dim i As Long
       Dim v As Variant
       
     
        folder$ = sDirName
        If Dir(folder$, vbDirectory) = "" Then
            MsgBox "Не найдена папка «" & folder$ & "»", vbCritical
            Exit Sub        ' выход, если папка не найдена
        End If
     
        Set coll = FilenamesCollection(folder$, sMask)        ' получаем список файлов по маске из папки
        If coll.Count = 0 Then
    '        MsgBox "В папке «" & Split(folder$, "\")(UBound(Split(folder$, "\")) - 1) & "» нет ни одного подходящего файла!", _
                   vbCritical, "Файлы для обработки не найдены"
            Exit Sub        ' выход, если нет файлов
        End If
     
       Set EX = New Application
       EX.Visible = False
       
       ' перебираем все найденные файлы
       For Each file In coll
        
          Cells(lRow, 2) = CStr(file)
          
          Set wkb = EX.Workbooks.Open(Filename:=file)
    
          ' Если книга не пуста
          If wkb.Sheets.Count > 0 Then
             i = 1
             ReDim v(1 To wkb.Sheets.Count)
             ' Получаем названия листов
             For Each wks In wkb.Sheets
                v(i) = wks.Name
                i = i + 1
             Next wks
    
          End If
    
          Cells(lRow, 3) = Join(v, ",")
    
          wkb.Close False
                
          DoEvents
          
          lRow = lRow + 1
        
          DoEvents
        Next file
        
       Set wks = Nothing: Set wkb = Nothing: Set EX = Nothing
       Set colShts = Nothing
        
    End Sub
    
    Sub LoopThroughDirs()
       Dim lLastRow As Long
       Dim lRow As Long
       Dim i As Long
       Dim v As Variant
       Dim dTime As Double
    
       lRow = 2
       lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
       
       v = Range(Cells(2, 1), Cells(lLastRow, 2))
       
       dTime = Time()
       For i = LBound(v) To UBound(v)
          Application.StatusBar = "Обрабатывается директория " & i & " из " & UBound(v)
          Call LoopThroughFiles(v(i, 1), lRow, "*.xls")
          Call LoopThroughFiles(v(i, 1), lRow, "*.xlsx")
          Call LoopThroughFiles(v(i, 1), lRow, "*.xlsm")
          DoEvents
       Next i
       MsgBox "Готово за " & CStr(CDate(Time() - dTime))
    End Sub


    для запуска в первой колонке заполнить директории которые он будет смотреть. Просматриваются вложенные директории до 999 грубины.

    Запустить процедуру LoopThroughDirs, для этого поставить курсор на название и нажать F5

    Результат
    5f05adc35867d361594006.png
    Ответ написан
  • Как перевести формат ДАТА в ТЕКСТ в ячейках Excel?

    На самом деле все очень просто если есть в руках VBA

    Создаем модуль, добавляем функцию, вызываем функцию на листе.
    Public Function ToText(ByRef rng As Range) As String
       ToText = rng.Text
    End Function


    Результат
    5ef1cd94efcf3920919701.png
    Ответ написан
  • Как правильно отформатировать файл csv эксель для загрузки на портал госуслуг?

    Выберите ячейки, и установите для них текстовый формат. После заполните данные. Сохраните файл. После открытия данные должы остаться в текстовом формате.
    Для сохранения в csv выбираете в меню Файл "Сохранить как" и выбираете формат csv.
    Ответ написан
  • Как быстро заполнить цифрами от 1-500 а потом повтор, что бы не протягивать в ручную ??

    Как вариант
    в первой ячейке записать 1
    - Поставить курсор во вторую ячейку
    - Переместится ползунком вниз листа и удерживая клавишу Shift сделать клик по последней ячейке столбца. Выделится рабочий диапазон
    - Поставить курсор в строку формул и ввести формулу =ЕСЛИ(R[-1]<500;R[-1]C+1;1) если у Вас в названиях столбцов числа, или =ЕСЛИ(A1<500;A1+1;1) если в названиях столбцов буквы (внимание, в формуле в этом случае поправить букву столбца). Нажать Ctrl+Enter
    - Рабочий диапазон Заполнится формулой. Не снимая выделения делаем копировать (Ctrl+С) и вставить только значения (Ctrl+Alt+V)
    Ответ написан
  • Как в таблице вывести минуса?

    Включить Фильтр.
    Отфильтровать по отрицательным значениям в нужном столбце.
    Выделить все (Ctrl-A), скопировать и вставить на нужный лист
    Повторить для всех листов

    Либо писать макрос если это задача периодическая
    Ответ написан
  • Как протянуть ячейки на определенное кол-во строк без мыши?

    1 - Выделяешь ячейку с формулой
    2 - Тянешь выделение на нужный размер (клавиши стрелка при нажатой shift)
    3 - Получается выделенная область с активной ячейкой там где формула
    4 - Нажимаешь F2 - режим правки (в ячейке с формулой появится курсор)
    5 - Нажимаешь Ctrl + Enter и Ваша Формула скопирована на все выделение.
    Ответ написан
  • Как получать адрес ячейки в Excel?

    все зависит от потребностей и знаний.
    Если Вы хорошо знакомы с PhpSpreadsheet тогда на нем.
    Если Вам результат нужен в этом же файле, тогда надо делать макросом VBA. Доступ к VBA встроен в пакет office. Язык простой. Информации в нете полно.
    Ответ написан
  • Как можно автоматизировать массовое переименование ячеек в execel?

    Все три варианта, которые Вы описали возможны.
    1- можно формулами. Нужно наличие списка соответствий. Смотрите функцию ВПР.
    2- можно макросом. Надо писать код.
    3- можно внешними скриптами. Тут вариантов много. Зависит от вашего програмного обеспечения.
    Ответ написан
  • Как автоматизировать такой процесс?

    Можно сделать средствами самого Excel, но придется писать макрос в Excel и скрипт в google.
    1- Зайти, залогиниться, скачать файл
    2- Прочитать файл
    3- отправить в гугл
    4- скрипт google получает данные и раскладывает в нужные таблицы

    Если доступ открытый, т.е. логиниться не надо, то можно обойтись и без Excel. Напрямую из гугл скрипта скачивать данные и разбирать.
    Ответ написан
  • Макрос который для каждого значение в ячейке до и после добавляет текст?

    И в чем Вам здесь помощь нужна?
    Где пример Вашей наработки, в которой у Вас что то не получается?
    Ответ написан
  • Как оптимизировать код в VBA?

    1-е
    Оживить Excel (т.е. избавить его от зависания) Вы можете путем добавления перед каждой инструкцией "next ..." команды "DoEvents". Но хочу предупредить, что это увеличит общее время выполнения всего кода, т.е. эта команда заставляет Excel останавливать Ваш код и обрабатывать действия пользователя или системные, которые к этому моменту накопились.
    Пример
    ...
        DoEvents
    next x
    ...


    2-е
    Вам надо избавиться от частого обращения к ячейкам. Это делается путем копирования всего дампа данных за один раз.
    вместо
        For i = 1 To rows
            arrStreet(i - 1) = Cells(i, 71)
            arrHouse(i - 1) = Cells(i, 15)
            arrCampus(i - 1) = Cells(i, 34)
        Next i
    
    Используем
            'таким образом мы убираем цикл длиной в 180к *3 обращений к листу
            ' если протестировать затраты времени только на этом участке, экономия будет колоссальная
            arrStreet = range(Cells(1, 71), Cells(rows, 71))
            arrHouse = range(Cells(1, 15), Cells(rows, 15))
            arrCampus = range(Cells(1, 34), Cells(rows, 34))
            
           ' Но т.к. теперь мы имеем 2х мерные массивы, их надо обратить в одномерные, т.к. последующий код использует одномерные.
           arrStreet = WorksheetFunction.Transpose(arrStreet)
           arrHouse = WorksheetFunction.Transpose(arrHouse )
           arrCampus = WorksheetFunction.Transpose(arrCampus )


    3-е
    Далее по коду идут постоянные обращения к ячейкам внутри вложенных циклов
    5cc2af9e419d8174137510.jpeg

    В общем надо проанализировать алгоритм и убрать все циклические обращения к ячейкам. Заменить их обращениями к массивам, которые предварительно будут заполнены копированием дампов (как показано выше).
    Далее (возможно?!, если позволит алгоритм) уменьшить количество циклов за счет сортировки исходных данных и бинарного поиска по массивам.
    Для справки: Бинарный поиск находит данные примерно за 7-8 обращений к массиву, тогда как простой перебор (который организован у Вас) делает в худшем случае 180к обращений.

    Здесь есть простор для оптимизации.
    И сделайте бэкап перед редактированием.
    Ответ написан
  • Как соединить макрос с документом?

    Скорее всего что макрос у Вас в модуле, поэтому просто перетащите модуль из одного проекта в другой

    5cb7824e588dd196051907.jpeg
    Ответ написан
  • Как сделать, чтобы эксель сохранял числа, а не даты?

    Один из вариантов, добавить перед числом апостроф " ' ", Excel его видит и не отображает.
    Но когда Вы будете сохранять в csv, скорее всего он его тоже сохранит, и Ваш csv может быть не корректным. Надо пробовать.
    Ответ написан
  • Как в VBA вывести объект в Immediate Window?

    Без дополнительного кодирования никак

    Если это Ваш класс, допишите ему функцию преобразования в строку.
    Если нет, придётся написать отдельно код вывода
    Ответ написан
  • Как быстро вставить 300К записей в Excel файл через VBS?

    проверьте что тормозит Ваш код. участками запускайте и измеряйте скорость выполнения

    Модуль класса для проверки скорости выполнения участка кода
    '---------------------------------------------------------------------------------------
    ' Module    : CTimeCounter
    ' DateTime  : 25.12.2017 00:25
    ' Author    : Mike Woodhouse
    ' Purpose   : Класс таймера для подсчета времени работы кода
    '
    '            Sub test()
    '               Dim tc As New CTimeCounter
    '               tc.StartCounter
    '                 Тестируемый код
    '               Debug.Print tc.TimeElapsed
    '            End Sub
    '
    '---------------------------------------------------------------------------------------
    Option Explicit
    
    Private Type LARGE_INTEGER
        lowpart As Long
        highpart As Long
    End Type
    
    #If VBA7 Then
       Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As LARGE_INTEGER) As Long
       Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As LARGE_INTEGER) As Long
    #Else
       Private Declare Function getTickCount Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
       Private Declare Function getFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
    #End If
    
    
    
    Private m_CounterStart As LARGE_INTEGER
    Private m_CounterEnd As LARGE_INTEGER
    Private m_crFrequency As Double
    
    Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
    '
    
    Private Function LI2Double(LI As LARGE_INTEGER) As Double
    Dim Low As Double
        Low = LI.lowpart
        If Low < 0 Then
            Low = Low + TWO_32
        End If
        LI2Double = LI.highpart * TWO_32 + Low
    End Function
    
    Private Sub Class_Initialize()
    Dim PerfFrequency As LARGE_INTEGER
        getFrequency PerfFrequency
        m_crFrequency = LI2Double(PerfFrequency)
    End Sub
    
    Public Sub StartCounter()
        getTickCount m_CounterStart
    End Sub
    
    Property Get TimeElapsed() As Double
    Dim crStart As Double
    Dim crStop As Double
        getTickCount m_CounterEnd
        crStart = LI2Double(m_CounterStart)
        crStop = LI2Double(m_CounterEnd)
        TimeElapsed = (1000# * (crStop - crStart)) / m_crFrequency
    End Property


    2.
    obj_WorkSheet.Cells()
    Такое обращение в ячейке, даже без доступа к БД, при наличии 300к обращений, уже будет тормозить Ваш Excel. Собирайте все в 2х мерный массив и присваивайте одним присваиванием

    Возможно будет уместным получить весь блок данных и обрабатывать его уже в Excel
    А может разделить один большой запрос на несколько?
    Ответ написан