Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Работа по оптимизации кода, Ускорение работы макроса сборки данных
 
Жители "планеты Excel "? приветствую Вас!
Есть работающий макрос. Составлен из кучи решений и подсказок разных авторов Планеты Excel из разных времён.
Макрос работает.
При загрузке небольших массивов данных всё было хорошо (терпимо).
Но  при загрузке больших объёмов данных (50-60 листов) макрос тормозит.
Я никогда не занимался "оптимизацией кода" и предполагаю что специалистам на "мой" код смотреть будет больно.
Тем не менее, передо мной задача стоит и решать её как-то надо.
Файл примера  (только один макрос и только шапка таблицы, которую собственно макрос заполняет, данными из файлов (прописан путь)) данный ресурс не принимает, поскольку видимо только текст макроса (там более нет ничего)  весит 971 КБ.
Готов выслать сам файл и при необходимости, пару файлов с данными, тому кто возьмётся за данную задачку.
Не хочу обидеть специалистов низкой суммой, но но так, навскидку скажу, что мне не жалко будет заплатить 1 000 руб. за реальную помощь в существенном ускорении работы макроса (с комментариями по тексту кода).
       
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Приветствую всех Жителей Планеты!
На форуме есть закрытая тема "автоматичский вывод постраничных итогов" (вот она:https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=25187&MID=220944#message220944)

Участник Казанский вывел превосходное решение, которое вполне удовлетворило автора темы и я рад за него.

Попытался я его применить к своему файлу с другой структурой, но ничего не вышло, а проблема остаётся.
Помогите пожалуйста, кто сможет:
В таблице на последней строке каждой печатной страницы необходимо указать Число порядковых номеров на странице (счёт по столбцу A)
и Общий итог фактического кол-ва штук на странице (сумма по столбцу H).
Я пытался менять код, но не получил нужного результата.
Прикладываю файл.
Спасибо всем кто откликнется.  
Получить наименование активного приложения, При открытии файла получить наименование приложения, которое его открыло
 
Приветствую всех жителей Планеты!
Разными путями многие пытаются зашифровать свои данные и макросы.
Но известно, что открыв файл xlsm в Либре офисе, там в редакторе всё видно и никакие простые защиты тут не помогут.
Отсюда появилась мысль:
А что если макрос при открытии сможет получить наименование приложения и тем самым запустить удаление закрытых данных, если приложение не равно предназначенному MS Excel?

Вопрос только в одном:
Как получить наименование активного приложения, в котором открыт файл?
Удалить конкретные файлы, открытые из исходной папки.
 
Доброго дня всем.
Тема избита, но решения именно моей задачи не увидел.
Есть личная книга макросов (Personal), из которой вызываются макросы для обработки файлов xlsx.
Файлы хранятся в исходной папке с именем (для примера) "Старая"
Все файлы в данной папке открываются макросом
Код
Sub Открыть()
Dim s As String, fldr As String
fldr = "c:\ФОТ\Старая\"
s = Dir(fldr & "*.xlsx")
Do While s <> ""
    With Workbooks.Open(fldr & s)
        'действия с книгой
'        .Close
    End With
    s = Dir
Loop
End Sub
После открытия всех файлов пользователь выполняет нужные действия с ними и другой кнопкой вызывает второй макрос,  который после выполнения нужных действий, сохраняет уже изменённый файл в другую папку на диске с именем "Новая" вот с этим кодом:
Код
Sub Изменить()
'
    Application.ScreenUpdating = False 'Выключить/Включить обновление экрана False

    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").ColumnWidth = 8.43
        
        PartOfName1 = ActiveWorkbook.ActiveSheet.[A1]
    ActiveWorkbook.SaveAs Filename:="c:\ФОТ\Новая\" & PartOfName1 & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False, Local:=True

    ActiveWindow.Close True 'Закрыть сохранить без запроса на сохранение

    Application.ScreenUpdating = True 'Выключить/Включить обновление экрана True
End Sub

Весь вопрос в том, что нужно в исходной папке "Старая" исходный файл уже отработанный удалить.
Прошу помощи, поскольку у самого уже мозг кипит.
Заранее благодарен.
Цикл по заполнению большого массива значениями, большой массив данных необходимо заполнить результатами вычисления формулы (значениями)
 
Приветствую Вас, о жители планеты Excel !
Много лет уже пользуюсь файлами, сконструированными из решений данного ресурса, за что премного благодарен!
Но приходится расти. У меня появилась задача, с которой мои знания уже не справляются. Полагаю нужен цикл (с которыми я вообще никогда не работал).
"Почитать" не помогло (наверное старею).
Отсюда просьба о помощи:
Есть файл с базой, в который на один лист собирается порядка 30-ти файлов в одну стройную таблицу данных.

В первом столбце "Бренд" содержатся значения брендов производителей проданного товара.

Во втором столбце  сумма выручки.

В третьем столбце Сумма премии, которая выражена как формула.

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

Если в заполняемом поле значение "Бренд" (по полному соответствию) отсутствует в справочнике брендов с повышенными процентами, формула (ВПР) возвращает значение ячейки с именем "Процент_базовый".

Если значение "Бренд" присутствует в справочнике, то формула возвращает расценку, предусмотренную справочником.

В небольшом массиве это работает прекрасно с формулами.

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

Обработка формулами будет сильно затруднена или вообще невозможна.

Поэтому задачей является заполнение поля циклом с результатом вычисления формулы макросом.

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

Критерием для поиска последней строки может быть первый столбец.

Буду признателен за помощь!
Файлик примера прилагаю.
Макрос дублирование строк в заданном диапазоне, Доработка существующего макроса
 
Здравствуйте, Жители Планеты!
Автор casag представил макрос, который добавляет строки в список, и каждую строку дублирует нужное число раз.
Вот код:
Код
Sub InsertRows()
Dim i As Long, lr As Long
    With Application
        .ScreenUpdating = False '
        .Calculation = xlCalculationManual '
         lr = Cells(Rows.Count, "B").End(xlUp).Row 'находим последнюю заполненную ячейку в столбце "В"
            For i = lr To 2 Step -1 'Цикл от последней ячейки до второй
                Rows(i).Copy 'копируем строку
 'от скопированной строки смещаемся на одну строку вниз и вставляем два раза скопированную строку
                Rows(i).Offset(1, 0).Resize(2).EntireRow.Insert
            Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    MsgBox "Строки добавлены!", vbInformation, "Вставка строк"
End Sub

Подскажите пожалуйста, как задать макросу диапазон, который обработает только строки ниже определённого уровня (не трогая "шапку")
Спасибо всем !
Изменено: Konstanta - 18.02.2020 10:18:20
[ Закрыто] Объединение данных чрез With, Как при сборе данных из нескольких файлов на один лист, пропустить первую строку (шапку)
 
Приветствую "жителей Планеты"!
Прошу помочь со старым макросом, который любезно предоставили здесь в 2009 году.
Макрос собирает на один лист данные из разных файлов. Работает замечательно уже несколько лет.
Устраивает всё!
Но необходимо собирать данные с листов, кроме первой строки, в которой помещена "шапка", поскольку  иначе в массив данных попадают и все шапки всех файлов, из которых массив собран.
Таким образом, нужно чтобы все данные копировались начиная со второй строки, а первую строку не затрагивали. Причём мне очень нужно в этом макросе иметь возможность изменять (по необходимости) номер строки, с которой начинается сбор данных.

Вот текст макроса:

Sub Консолидировать_данные()

Const strStartDir = "c:\Управленческий анализ\Импорт\" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\Управленческий анализ\Экспорт\" 'папка, в которую будет предложено сохранить результат

Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _
i As Integer, stbar As Boolean, clTarget As Range, iLastRow As Long


On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application  ' меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1)
.ScreenUpdating = False
stbar = .DisplayStatusBar
.DisplayStatusBar = True

For i = 1 To UBound(arFiles)
.StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)
Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)
For Each shSrc In wbSrc.Worksheets
If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой

'определяем ячейку, в которую будем копировать
' до первого копирования iLastRow=0
Set clTarget = shTarget.Range("a1"  ;)  .Offset(iLastRow, 0)

If blInsertNames Then
clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name
Set clTarget = clTarget.Offset(1, 0)
End If
shSrc.UsedRange.Copy clTarget

'определяем последний заполненный ряд для следующего копирования _
4 - это колонка, по которой смотрим последнюю ячейку, можно дописать +1 _
или больше, если нужен пробел после импорта данных
iLastRow = shTarget.Cells(shSrc.Rows.Count, 1).End(xlUp).Row

End If
Next
wbSrc.Close False 'закрыть без запроса на сохранение
Next
.ScreenUpdating = True
.DisplayStatusBar = stbar
.StatusBar = False

On Error Resume Next 'если указанный путь не существует и его не удается создать,
'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0

arFiles = .GetSaveAsFilename("Консолидированный реестр", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу" )
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя
GoTo save_err
Else
On Error GoTo save_err
wbTarget.SaveAs arFiles

ActiveWorkbook.Close

End If
End
save_err:
MsgBox "Книга не сохранена!", vbCritical
End With
End Sub



Заранее благодарен,
С уважением  Константин.
Изменено: Konstanta - 28.12.2013 19:27:11
Добавление источников к сводной таблице, В существующую таблицу добавлять данные за разные годы из разных файлов
 
Приветствую жителей "планеты". В 2010 году с Вашей помощью создал классный отчёт: смесь сводных таблиц, на основе базы, собираемой и обновляемой макросами.
Появилась проблема, которую прошу Опять помочь решить (пример пока не выкладываю):
есть (упрощённо) группа сводных таблиц, на основе базы данных, которая хранится прямо в файле на листе "База".
Во первых данных стало много.
Во вторых, появились другие пользователи, которым тоже нужно работать с этим отчётом.
Я хочу сделать несколько настроенных сводных отчётов, которые будут брать исходные данные из одного общего источника в следующем виде (то что я хочу):
1. В сетевой папке (к которой будут прописаны пути) лежат файлы с одинаковой структурой, но за разные периоды времени с именами типа "2011;2012;2013 и так далее.
2. Каждый из файлов пользователей будет иметь свой вид настойки отчётов но работать на одних и тех же источниках.
3. Для сводных таблиц планирую применить настроенный запрос "внешний источник данных".
Вопрос:
Так и не смог реализовать получение в одну сводную данных из разных файлов база_10, база_12, и т.д.
В идеале - нужно чтобы пользователь в фильтре один раз настроенной таблицы, выбирал нужный год (хранящийся в отдельном файле) так, как если бы данные находились в одной базе.
На самом деле файлы исходных данных очень большие. Массивы по 53 столба и более 500 тыс. строк.
В прикреплённом файле архив. Сам файл со сводной таблицей (простенькой для примера) и два файла - базы, из которых нужно получить данные. Связь в основном файле только с одним из них.
Заранее благодарен!
Изменено: Konstanta - 01.09.2013 21:14:42
Страницы: 1
Наверх