ymarkelova
Дата: Понедельник, 20.11.2023, 13:21 |
Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация:
0
±
Замечаний:
40% ±
2019
Коллеги, привет! Пожалуйста, помогите с созданием отчета. Суть: есть отчет в виде таблицы (судебные дела), из которого должен создавать другой отчет, в который подтягиваются данные. И нужно что бы данные отображались только за текущий месяц. На листе "сцепка" 2 столбца: дата последнего изменения (А) и сцепленный текст (В). Вопросы: 1. Как добавить в столбец А на листе "сцепка" дату последнего изменения в ячейках с листа судебные дела? К примеру, если изменения были 17.11. и 18.11, то отображалась только 18.11. 2. как убрать ошибку в части код? [vba]Код
wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx"
[/vba] Код целиком:
[vba]
Код
Sub Module4() Dim xlApp As Object Dim wb As Object Dim ws As Object Set xlApp = CreateObject("Excel.Application") Set ws = ThisWorkbook.Sheets("сцепка") HomeDir$ = ThisWorkbook.Path i% = 2 'Начинаем со второй строки Do If ws.Cells(i%, 1).Value = "" Then Exit Do If ws.Cells(i%, 1).Value <> "" Then s1$ = ws.Cells(i%, 1).text s2$ = ws.Cells(i%, 2).text s3$ = ws.Cells(i%, 3).text s4$ = ws.Cells(i%, 4).text s5$ = ws.Cells(i%, 5).text FileCopy HomeDir$ & "\Otchet.xlsx", HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" Set wb = xlApp.Workbooks.Open(HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx") On Error GoTo ErrorHandler ' Введите здесь ваш код ws.Cells(i%, 1).Value = Now 'Установить дату последнего изменения в столбец A i% = i% + 1 'Смещение на следующую строку End If Loop wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" wb.Close xlApp.Quit Exit Sub ErrorHandler: wb.Close xlApp.Quit End Sub
[/vba]
Коллеги, привет! Пожалуйста, помогите с созданием отчета. Суть: есть отчет в виде таблицы (судебные дела), из которого должен создавать другой отчет, в который подтягиваются данные. И нужно что бы данные отображались только за текущий месяц. На листе "сцепка" 2 столбца: дата последнего изменения (А) и сцепленный текст (В). Вопросы: 1. Как добавить в столбец А на листе "сцепка" дату последнего изменения в ячейках с листа судебные дела? К примеру, если изменения были 17.11. и 18.11, то отображалась только 18.11. 2. как убрать ошибку в части код? [vba]Код
wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx"
[/vba] Код целиком:
[vba]
Код
Sub Module4() Dim xlApp As Object Dim wb As Object Dim ws As Object Set xlApp = CreateObject("Excel.Application") Set ws = ThisWorkbook.Sheets("сцепка") HomeDir$ = ThisWorkbook.Path i% = 2 'Начинаем со второй строки Do If ws.Cells(i%, 1).Value = "" Then Exit Do If ws.Cells(i%, 1).Value <> "" Then s1$ = ws.Cells(i%, 1).text s2$ = ws.Cells(i%, 2).text s3$ = ws.Cells(i%, 3).text s4$ = ws.Cells(i%, 4).text s5$ = ws.Cells(i%, 5).text FileCopy HomeDir$ & "\Otchet.xlsx", HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" Set wb = xlApp.Workbooks.Open(HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx") On Error GoTo ErrorHandler ' Введите здесь ваш код ws.Cells(i%, 1).Value = Now 'Установить дату последнего изменения в столбец A i% = i% + 1 'Смещение на следующую строку End If Loop wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" wb.Close xlApp.Quit Exit Sub ErrorHandler: wb.Close xlApp.Quit End Sub
[/vba]
ymarkelova
Ответить
Сообщение Коллеги, привет! Пожалуйста, помогите с созданием отчета. Суть: есть отчет в виде таблицы (судебные дела), из которого должен создавать другой отчет, в который подтягиваются данные. И нужно что бы данные отображались только за текущий месяц. На листе "сцепка" 2 столбца: дата последнего изменения (А) и сцепленный текст (В). Вопросы: 1. Как добавить в столбец А на листе "сцепка" дату последнего изменения в ячейках с листа судебные дела? К примеру, если изменения были 17.11. и 18.11, то отображалась только 18.11. 2. как убрать ошибку в части код? [vba]Код
wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx"
[/vba] Код целиком:
[vba]
Код
Sub Module4() Dim xlApp As Object Dim wb As Object Dim ws As Object Set xlApp = CreateObject("Excel.Application") Set ws = ThisWorkbook.Sheets("сцепка") HomeDir$ = ThisWorkbook.Path i% = 2 'Начинаем со второй строки Do If ws.Cells(i%, 1).Value = "" Then Exit Do If ws.Cells(i%, 1).Value <> "" Then s1$ = ws.Cells(i%, 1).text s2$ = ws.Cells(i%, 2).text s3$ = ws.Cells(i%, 3).text s4$ = ws.Cells(i%, 4).text s5$ = ws.Cells(i%, 5).text FileCopy HomeDir$ & "\Otchet.xlsx", HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" Set wb = xlApp.Workbooks.Open(HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx") On Error GoTo ErrorHandler ' Введите здесь ваш код ws.Cells(i%, 1).Value = Now 'Установить дату последнего изменения в столбец A i% = i% + 1 'Смещение на следующую строку End If Loop wb.SaveAs Filename:=HomeDir$ & "\" & "Otchet" & Format(Now(), "yy-MM-dd") & ".xlsx" wb.Close xlApp.Quit Exit Sub ErrorHandler: wb.Close xlApp.Quit End Sub
[/vba]
Автор - ymarkelova Дата добавления - 20.11.2023 в 13:21
NikitaDvorets
Дата: Вторник, 21.11.2023, 12:03 |
Сообщение № 2
Группа: Авторы
Ранг: Ветеран
Сообщений: 604
Репутация:
137
±
Замечаний:
0% ±
Excel 2019
Добрый день. Вариант с пользовательскими функциями (см. примечания).
Добрый день. Вариант с пользовательскими функциями (см. примечания). NikitaDvorets
Ответить
Сообщение Добрый день. Вариант с пользовательскими функциями (см. примечания). Автор - NikitaDvorets Дата добавления - 21.11.2023 в 12:03