Страницы: 1
RSS
Список сотрудников брать из листа с текущего месяца
 
Есть список сотрудников предприятия, который ведётся отделом кадров вручную. Нужно сделать таблицу с актуальными контактами сотрудников. Пример. В файле сотрудники.xls ведётся несколько листов. Январь, февраль, март и т.д. На листе Март содержится самая актуальная информация о сотрудниках. Я создал файл контакты.xls, указав брать список сотрудников из файла сотрудники.xls с листа март. Всё вроде как работает. Но наступит апрель, и всё нужно будет переделывать заново. Собственно вопрос. Как сделать так, чтобы список сотрудников брался из листа с текущего месяца?
 
Цитата
yealink написал: Есть список сотрудников
А пример для форума есть?
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Добрый день!

Возник аналогичный вопрос.
Как оптимально сделать: нужно считать имя листов (Январь, Февраль... , Декабрь) и найти Лист=текущему месяцу?
 
В Правилах форума..... нужно приложить файл примера и написать какой результат вы хотите получить и с каких конкретно данных таблицы.

Без этого ваш вопрос и вопрос ТС никто рассматривать не будет.
Изменено: Marat Ta - 20.02.2021 10:36:20
 
Цитата
yealink написал:
файл контакты.xls, указав брать список сотрудников из файла сотрудники.xls с листа март
если логика книги такая что все листы одинаковые по структуре и листы - это месяца, то вам поможет функция АДРЕС, но дальше без исходного примера не помочь
чтоб дело мастера боялось, он знает много страшных слов.
 
Задача такая:
1. Каждое первое число каждого месяца открывается файл "Файл для записи" - здесь нужно прочитать лист с названием текущего месяца (например, сегодня первое февраля - ищем лист февраль)
2. Далее открываем файл "Файл для чтения" - ищем в столбце "Дата" (С) - все даты ПРЕДЫДУЩЕГО месяца (то есть в нашем случае - все даты января)
3. Далее в файле "Файл для чтения" - ищем в столбце "Мероприятия" все мероприятия с началом "Заг"
4. Далее копируем данные за предыдущий месяц из файла "Файл для чтения"  "объект"/"Локация"  - записываем (транспонируем) в файл "Файл для чтения", распределяя их по соответствующим дням

// в приложенных файлах нужные данные выделила цветом.
// Копируем данные, выделенные светло-зеленым

Начата работа с макросами, пока есть вопросы по чтению месяца с листа.
Заранее спасибо за уделенное время!

P.S. Я - начинающий. И знаю, что дорогу осилит идущий.
 
Код
Sub Main()
    Dim wbRead As Workbook
    Set wbRead = GetWb("Файл_для_чтения.xlsx")
    If wbRead Is Nothing Then Exit Sub
    
    Dim wbWrite As Workbook
    Set wbWrite = GetWb("Файл_для_записи.xlsx")
    If wbWrite Is Nothing Then Exit Sub
    
    Dim shRead As Worksheet
    Set shRead = GetSh(wbRead, "Мероприятия 2021")
    If shRead Is Nothing Then Exit Sub
    
    Dim dt1 As Date
    dt1 = DateSerial(Year(Now), Month(Now) - 1, 1)  'Передаётся для определения месяца
    Dim sMonth As String
    sMonth = Format(dt1, "MMMM")
    Dim shWrite As Worksheet
    Set shWrite = GetSh(wbWrite, sMonth)
    If shWrite Is Nothing Then Exit Sub
    
    Dim aRead As Variant
    aRead = ReadData(shRead)
    
    Dim aWrite As Variant
    aWrite = JobData(aRead, dt1)
    
    WriteData shWrite, aWrite
End Sub

Sub WriteData(shWrite As Worksheet, aWrite As Variant)
    With shWrite
        .Range(.Cells(3, 1), .Cells(.Rows.Count, .Columns.Count)).Clear
        .Cells(3, 4).Resize(UBound(aWrite, 1), UBound(aWrite, 2)) = aWrite
    End With
End Sub

Function JobData(aData As Variant, dt1 As Date) As Variant
    Dim arr As Variant
    ReDim arr(1 To 2 * UBound(aData, 1), 1 To 31)
    
    Dim x As Byte
    Dim y As Long
    Dim u As Long
    u = 1
    For y = 6 To UBound(aData, 1)
        If Left(LCase(aData(y, 4)), 3) = "заг" Then
            If IsDate(aData(y, 3)) Then
                If Month(aData(y, 3)) = Month(dt1) Then
                    If Year(aData(y, 3)) = Year(dt1) Then
                        x = Day(aData(y, 3))
                        arr(u + 0, x) = aData(y, 1)
                        arr(u + 1, x) = aData(y, 2)
                        u = u + 2
                    End If
                End If
            End If
        End If
    Next
    
    JobData = arr
End Function

Function ReadData(shRead As Worksheet) As Variant
    With shRead
        Dim y As Long
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim arr As Variant
        arr = .Range(.Cells(1, 1), .Cells(y, 4))
    End With
    
    
    ReadData = arr
End Function

Function GetSh(wb As Workbook, s As String) As Worksheet
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = wb.Worksheets(s)
    On Error GoTo 0
    If sh Is Nothing Then
        MsgBox "Не найден лист " & s, vbExclamation
    End If
    Set GetSh = sh
End Function

Function GetWb(s As String) As Workbook
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(s)
    On Error GoTo 0
    If wb Is Nothing Then
        MsgBox "Не найден файл " & s, vbExclamation
    End If
    Set GetWb = wb
End Function
 
Разобралась.
Спасибо большое!
Страницы: 1
Наверх