- не ну можно конечно Function DaysUntilToday(startDate as Date) as long форматом представить как дату... Ведь дата - это число дней, так что нет противоречия.
RUSBelorus написал: Можно готовый вариант просто выложить ?
- вот с этого и нужно начинать - готовый файл с кодом, на нём и проверим сразу, и источники откуда тянуть если там в коде что-то заточенное на эти файлы. А так можно долго ждать неленивых... это не я ))
pliplim написал: добавлен пункт по удалению ненужных столбцов
- включаете запись макроса, удаляете столбец (или сразу все), выключаете запись. Добавляете этот код в свой макрос. Если нужно удалять столбцы по одному - удаляйте с конца листа, т.к. они сдвигаются, и так будет проще код.
pliplim, если начальство требует такую аналитику - ну пусть вложится в программы и специалиста, Эксель не входит в перечень программ по бизнесаналитике. И получит совсем другой уровень анализа данных.
oleg-zuev написал: Не работает. Эксель заблокировал макрос.
- не понял к чему этот ответ. Если к моему файлу - я макрос не стал удалять, т.к. он там уже зачем-то был, но я его никак в решении не использовал, можно без него посмотреть.
oleg-zuev, как вариант - нужно было гуглить как заполнить пустые ячейки значением из предыдущей ячейки, это легко гуглится. И тогда эти формулы можно копипастить без коррекции и без допстолбцов.
На практике источники бывают какие угодно, потому и есть такое понятие как ETL - extract, transform, load. Идеально конечно когда достаточно просто загрузить из источника, но такого не помню. Для анализа динамики и по людям как раз нужна сводная+срезы+диаграммы
Sub tt()
Dim a, i&, ii&
a = Sheets("Лист1").[a1].CurrentRegion.Value
For i = 1 To 32
If i <> 16 Then
ii = ii + 1
Selection.Value = a(ii, 1)
End If
Selection.Offset(, 1).Select
Next
End Sub
Если исходные данные преобразовать в аналогичные прямые таблицы - можно вручную слить всё в одну модель, связать по ФИО и далее вывести в сводную и поставить срезы. Ну а для таких таблиц нужно PQ или макрос применять, если работа частая. Чтобы привести исходные данные в нормальный вид. Если разовая - можно и руками конечно...
Ну можно и в макросе без поиска прописать конкретные адреса ячеек, будет код проще и чуть быстрее. И если к этим бланкам не касались шаловливые руки юзеров - то всё будет ОК, иначе те же 90%
Вот спросил (скопировал что выше написал) - должно сработать, только дописать цикл поиска значений, и вывод на лист:
Код
Вот макрос на VBA, который открывает все .xlsx файлы в указанном каталоге, выполняет поиск ячеек на активном листе и извлекает данные из соседней ячейки:
Sub ProcessXlsxFiles()
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim searchValue As String
Dim foundCell As Range
Dim result As String
Dim folderPath As String
' Укажите путь к папке
folderPath = "C:\YourFolderPath\" ' Замените на ваш путь
' Создаем объект FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
' Значение для поиска
searchValue = "YourSearchTerm" ' Замените на искомое значение
' Перебираем файлы в папке
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then
' Открываем файл
Set wb = Workbooks.Open(file.Path)
Set ws = wb.ActiveSheet
' Поиск всех вхождений
Set foundCell = ws.Cells.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
Dim firstAddress As String
firstAddress = foundCell.Address
Do
' Получаем значение из соседней ячейки (справа)
result = foundCell.Offset(0, 1).Value
' Здесь можно обработать результат, например, вывести или сохранить
Debug.Print "Найдено в " & file.Name & ", ячейка " & foundCell.Address & ": " & result
' Ищем следующее вхождение
Set foundCell = ws.Cells.FindNext(foundCell)
Loop Until foundCell.Address = firstAddress Or foundCell Is Nothing
Else
Debug.Print "В файле " & file.Name & " значение не найдено"
End If
' Закрываем файл без сохранения
wb.Close SaveChanges:=False
End If
Next file
' Освобождаем объекты
Set fso = Nothing
Set folder = Nothing
MsgBox "Обработка завершена!"
End Sub
</xaiArtifact>
**Инструкции:**
1. Замените `folderPath` на путь к вашей папке (например, `"C:\Documents\ExcelFiles\"`).
2. Укажите `searchValue` — значение, которое нужно искать в ячейках.
3. Макрос открывает каждый .xlsx файл, ищет `searchValue` на активном листе, извлекает значение из ячейки справа от найденной и выводит результат в окно Immediate (Ctrl+G в редакторе VBA).
4. Для сохранения результатов вместо `Debug.Print` можно добавить код для записи в файл или лист.
**Примечания:**
- Убедитесь, что путь к папке заканчивается слешем `\`.
- Макрос не сохраняет изменения в файлах.
- Если значение не найдено, выводится сообщение об этом.
- Для работы с `FileSystemObject` не требуется подключения дополнительных библиотек.
YUdavihin, Доброго. Можно попросить ИИ написать макрос - открыть в цикле все xlsx файлы каталога, и на активном листе выполнить серию поиска ячеек, и брать данные в соседней ячейке от найденной. И писать на лист, или в массив и затем его на лист (массив можно создать по количеству файлов каталога). Ну или запрос PQ, но там уже наверное нужно по конкретному листу писать, а если он вдруг чуть поплывёт то больше шансов накосячить.
Добрый день. Судя по картинке - нужен макрос. Но вообще можно без макросов делать срезами, только данные удобнее иначе иметь, и скорее всего нужно будет доработать в модели. Можно всё делать руками, без PQ
Добрый день. В названии про перенос, в вопросе про поиск. Искать там в С нечего (там нет этих значений), что куда и в каком виде переносить собрались тоже непонятно. И почему переносить, а не копировать/отображать? Нужно пояснить, и с названием поработать. Ну а так есть ведь уже фильтр, вот там вписываете/выбираете и получаете результат...