по изменяемой ячейки Поиск диапазона дат на другом листе

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

по изменяемой ячейки Поиск диапазона дат на другом листе (Макросы/Sub)

farrid1965

Дата: Суббота, 15.02.2025, 21:12 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Добрый ночи
Не могу понять как организовать поиск по дате, связать следующее На листе "Отпуск" поиск даты по строке "4" и по найденному диапазону дат выделить ниже расположенные ячейки

[vba]

Код

Sub Макрос6()
'
' Макрос6 Макрос
Sheets("Табель").Select
' Изменение в ячейке "C3" январь
ActiveCell.FormulaR1C1 = "1"
Sheets("Отпуск").Select

' Здесь проблема как организовать На листе "Отпуск" поиск даты по строке "4" и по найденному диапазону дат выделить ниже расположенные ячейки

' ниже расположенные ячейки скопировать на лист "Табель" (копировать на лист "Табель" эта часть реализована)
'
Rows("4:4").Select

' отключаем обновление экрана для ускорения
Application.ScreenUpdating = False
Set wk = ThisWorkbook
' С листа "Отпуск" копируем диапазоны таблиц ("C7:AG46") и вставляем его на только что созданный лист по значению ячейки "C3" с листа под названием "Отпуск"
wk.Sheets("Отпуск").Range("C7:AG46").Copy
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteValues
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteColumnWidths
Sheets("Табель").Select
Application.CutCopyMode = False
' Изменение в ячейке "C3" февраль
ActiveCell.FormulaR1C1 = "2"
Sheets("Отпуск").Select

' Здесь проблема как организовать На листе "Отпуск" поиск даты по строке "4" и по найденному диапазону дат выделить ниже расположенные ячейки

' ниже расположенные ячейки скопировать на лист "Табель" (копировать на лист "Табель" эта часть реализована)

Rows("4:4").Select

' отключаем обновление экрана для ускорения
Application.ScreenUpdating = False
Set wk = ThisWorkbook
' С листа "Отпуск" копируем диапазоны таблиц ("AL7:BN21") и вставляем его на только что созданный лист по значению ячейки "C3" с листа под названием "Отпуск"
wk.Sheets("Отпуск").Range("AL7:BN21").Copy
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteValues
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteColumnWidths
End Sub

[/vba]

Код

[/vba]farrid1965

К сообщению приложен файл: dlja_excelworld_grafik2_vers4.xlsm (102.3 Kb)

Сообщение отредактировал farrid1965 - Суббота, 15.02.2025, 21:16

Ответить

СообщениеДобрый ночи
Не могу понять как организовать поиск по дате, связать следующее На листе "Отпуск" поиск даты по строке "4" и по найденному диапазону дат выделить ниже расположенные ячейки

[vba]

Код

[/vba]

Автор - farrid1965
Дата добавления - 15.02.2025 в 21:12

doober

Дата: Суббота, 15.02.2025, 22:29 | Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 991

Репутация: 344 ±

Замечаний: 0% ±

Excel 2010

Доброй[vba]

Код

Sub Macro()
    Dim wb As Workbook, Sh As Worksheet, Sh1 As Worksheet, rng As Range, dt As Date
    Dim dayInMon&, Mon&, x, ColumnStart&
    Set wb = ThisWorkbook
    Set Sh = wb.Worksheets("Табель")
    Mon = 1
    Sh.Range("C3") = Mon
    dayInMon = Sh.Range("Tdays")
    Set Sh1 = wb.Worksheets("Отпуск")
    x = Sh1.Cells(4, 1).Resize(1, Sh1.Cells(4, Sh1.Columns.Count).End(xlToLeft).Column)
    For i = 1 To UBound(x, 2)
        If x(1, i) <> "" Then
            dt = x(1, i)
            If Month(dt) = Mon Then
                ColumnStart = i + 1
                Set rng = Sh1.Cells(7, ColumnStart).Resize(40, dayInMon)
                rng.Copy
                'Вствляете сами, я не понял
                Exit For
            End If
        End If
    Next

    Mon = 2
    Sh.Range("C3") = Mon
    dayInMon = Sh.Range("Tdays")
    For i = 1 To UBound(x, 2)
        If x(1, i) <> "" Then
            dt = x(1, i)
            If Month(dt) = Mon Then
                ColumnStart = i + 1
                Set rng = Sh1.Cells(7, ColumnStart).Resize(40, dayInMon)
                rng.Copy
                'Вствляете сами, я не понял
                Exit For
            End If
        End If
    Next
End Sub

[/vba]

Сообщение отредактировал doober - Суббота, 15.02.2025, 22:29

Ответить

farrid1965

Дата: Понедельник, 17.02.2025, 12:34 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Добрый день

Я так понял строка

[vba]

Код

Set rng = Sh1.Cells(7, ColumnStart).Resize(40, dayInMon)

[/vba]

должна выделить на листе "Отпуск" от строки 7 и столбца 1, в диапазоне строк 40 и дней (столбцов) до 31
Но она не выделяет этот диапазон, поэтому приходится вставлять свой диапазон, чтобы эти ячейки "C7:AG46" скопировать на лист "Табель"

[vba]

Код

wk.Sheets("Отпуск").Range("C7:AG46").Copy
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteValues
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteColumnWidths

[/vba]

а хотелось бы чтоб в зависимости от количества дней копировались ниже стоящие ячейки

И еще при изменении ячейки C3 (там будут меняться месяца с января по декабрь)автоматически срабатывал бы макрос
Найденный мной макрос Не срабатывает

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Then
Call Macro
End If
End Sub

[/vba]

Сообщение отредактировал farrid1965 - Понедельник, 17.02.2025, 12:36

Ответить

doober

Дата: Понедельник, 17.02.2025, 12:46 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 991

Репутация: 344 ±

Замечаний: 0% ±

Excel 2010

Цитата farrid1965, 17.02.2025 в 12:34, в сообщении № 3 (

)

должна выделить на листе "Отпуск" от строки 7 и столбца 1, в диапазоне строк 40 и дней (столбцов) до 31

Не правильно, она выделяет диапазон в зависимости от месяца и количества дней в месяце

Ответить

farrid1965

Дата: Понедельник, 17.02.2025, 13:09 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Одну ошибку нашел у себя, я писал:

[vba]

Код

wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteValues
wk.Sheets("Табель").Cells(17, "F").PasteSpecial xlPasteColumnWidths

[/vba]

а надо было

[vba]

Код

wb.Worksheets("Табель").Cells(17, "F").PasteSpecial xlPasteValues
wb.Worksheets("Табель").Cells(17, "F").PasteSpecial xlPasteColumnWidths

[/vba]

Ответить

Pelena

Дата: Понедельник, 17.02.2025, 15:56 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 19456

Репутация: 4580 ±

Замечаний: ±

Excel 365 & Mac Excel

farrid1965, оформите текст кода тегами с помощью кнопки # в режиме правки поста. Можете посмотреть, как я это сделала в Вашем первом посте

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

farrid1965

Дата: Вторник, 18.02.2025, 11:05 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Добрый день.
Черт возьми Ватсон.

Цитата Pelena, 17.02.2025 в 15:56, в сообщении № 6 (

)

Можете посмотреть, как я это сделала в Вашем первом посте

У меня нет в первом посте кнопки правка или что-то я не понял

Ответить

farrid1965

Дата: Вторник, 18.02.2025, 11:41 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Плиз еще 1 вопрос:
в ячейке "C3" вношу цифру 1 (январь) нажимаю кнопку "Run" макрос обрабатывает как положено копирует данные на лист "Табель" но останавливает работу макроса только после того как исправляет сам в ячейке "C3" значение на 2 (февраль или 3 март то есть то что находится последним в макросе) изменяет ячейки по строке 16 на февраль на листе "Табель", но данные при этом оставляет январские

А можно как сделать так чтобы программа останавливала работу макроса пока я сам не проставлю цифру 2 (февраль) или 3 (март) и перед этим то есть как только я ввел цифру 2 или 3 и так далее удаляя все данные с диапазона ячеек ниже дат расположенные на листе "Табель" (скопированные с листа "Отпуск")

Блин что то походу "заумно" написал, но как спецы может поймете то, что я своими словами попробовал спросить

К сообщению приложен файл: dlja_excelworld_grafik2_vers5.xlsm (104.2 Kb) · 4887423.jpg (114.8 Kb)

Сообщение отредактировал farrid1965 - Вторник, 18.02.2025, 11:44

Ответить

Pelena

Дата: Вторник, 18.02.2025, 16:28 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 19456

Репутация: 4580 ±

Замечаний: ±

Excel 365 & Mac Excel

Цитата farrid1965, 18.02.2025 в 11:05, в сообщении № 7 (

)

У меня нет в первом посте кнопки правка

ну да, правка доступна в течение суток. Исправила за Вас

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

farrid1965

Дата: Вторник, 18.02.2025, 17:55 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Всем спасибо, особенно doober который сразу отреагировал на мое сообщение.

Вот если бы еще отреагировали на мое сообщению №8, можно было бы закрыть тему.

Ответить

doober

Дата: Вторник, 18.02.2025, 23:10 | Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 991

Репутация: 344 ±

Замечаний: 0% ±

Excel 2010

Последняя попытка, больше угадывать не буду.
P.S.Макрос нельзя остановить, что то сделать, потом продолжить.[vba]

Код

Sub Macro()
    Dim wb As Workbook, Sh As Worksheet, Sh1 As Worksheet, rng As Range, dt As Date
    Dim dayInMon&, Mon&, x, ColumnStart&
    Set wb = ThisWorkbook
    Set Sh = wb.Worksheets("Табель")
    Mon = Sh.Range("C3")
    dayInMon = Sh.Range("Tdays")
    Set Sh1 = wb.Worksheets("Отпуск")
    x = Sh1.Cells(4, 1).Resize(1, Sh1.Cells(4, Sh1.Columns.Count).End(xlToLeft).Column)
    For i = 1 To UBound(x, 2)
        If x(1, i) <> "" Then
            dt = x(1, i)
            If Month(dt) = Mon Then
                ColumnStart = i + 1
                Set rng = Sh1.Cells(7, ColumnStart).Resize(40, dayInMon)
                ' отключаем обновление экрана для ускорения
                Application.ScreenUpdating = False
                ' С листа "Отпуск" копируем диапазоны таблиц ("C7:AG46")
                rng.Copy
                'вставляем его на лист под названием "Табель"
                Sh.Cells(17, "F").PasteSpecial xlPasteValues
                Sh.Cells(17, "F").PasteSpecial xlPasteColumnWidths
                Application.ScreenUpdating = True
                Exit For
            End If
        End If
    Next
End Sub

[/vba]

Ответить

farrid1965

Дата: Четверг, 20.02.2025, 22:13 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

16.0.14332.20529

Цитата doober, 18.02.2025 в 23:10, в сообщении № 11 (

)

Последняя попытка,

Спасибо все работает. Супер.

Правда при срабатывании макроса почему то столбцы на листе "Табель" уменьшаются, до какого то своего размера (как будто в свойствах листа галочка "авторазмер" стоит), я расширяю столбцы нажимаю макрос он опять уменьшает. А так все супер макрос как часы работает.

Это наглядно видно по ячейкам со словом ТЕСТ

Еще раз спасибо, а про столбцы поищу на просторах интернета, ну или можно подсказку, я в справочнике EXEL гляну.

Тема закрыта.