Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Добавление данных из нескольких файлов в один файл по дате - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление данных из нескольких файлов в один файл по дате (Макросы/Sub)
Добавление данных из нескольких файлов в один файл по дате
Sergey6734 Дата: Вторник, 15.02.2022, 08:15 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Всем доброго дня. Народ ломаю голову, но не могу сложить код макроса воедино. Короче такая проблема есть два файла Excel Сводная таблица и куча нарядов на выполнения работ. В один день таких нарядов рождается от 5 до 10 и соответсвенно в конце месяца мне надо выдать зарплату. Чтобы не считать это вручную хотелось бы это складывать воедино. В сводной таблица есть дата и пять рабочих с табельными номерами через макрос открываю все наряды и надо чтобы он через дату которая есть во всех нарядах брал данные по зарплате и суммировал их на эту дату и так за каждый день
К сообщению приложен файл: ___.xlsm(20.6 Kb)
 
Ответить
СообщениеВсем доброго дня. Народ ломаю голову, но не могу сложить код макроса воедино. Короче такая проблема есть два файла Excel Сводная таблица и куча нарядов на выполнения работ. В один день таких нарядов рождается от 5 до 10 и соответсвенно в конце месяца мне надо выдать зарплату. Чтобы не считать это вручную хотелось бы это складывать воедино. В сводной таблица есть дата и пять рабочих с табельными номерами через макрос открываю все наряды и надо чтобы он через дату которая есть во всех нарядах брал данные по зарплате и суммировал их на эту дату и так за каждый день

Автор - Sergey6734
Дата добавления - 15.02.2022 в 08:15
Sergey6734 Дата: Вторник, 15.02.2022, 16:32 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Есть вот такая часть кода просто надо сюда добавить распознание дат и заполнение свода по датам с суммированием данных
[vba]
Код
Sub Результат_по_осям()
Dim avFiles
'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
avFiles = Application.GetOpenFilename _
("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
If VarType(avFiles) = vbBoolean Then
'была нажата кнопка отмены - выход из процедуры
Exit Sub
End If
'avFiles - примет тип String
Dim tab_worker As String
Dim i, j, count, column As Integer
Dim result As Double
Dim flag As Boolean
count = 4
For Each x In avFiles
Workbooks.Open x
i = 6
Dim Name As String
Name = ActiveWorkbook.Name
Do While ActiveWorkbook.Sheets("Свод").Cells(i, 2).Value <> ""
Workbooks(Name).Activate
For k = 4 To 1000

If ActiveWorkbook.Sheets("Свод").Cells(4, k).Value = "Сумма" Then

column = k
k = 1001

End If

Next

result = CDbl(ActiveWorkbook.Sheets("Свод").Cells(i, column).Text)
tab_worker = ActiveWorkbook.Sheets("Свод").Cells(i, 3).Value
Workbooks("Свод по сварки осей.xlsm").Activate
flag = True
j = 3
Do While flag = True

If tab_worker = ActiveWorkbook.Sheets("Свод").Cells(j, 3).Value Then

flag = False
ActiveWorkbook.Sheets("Свод").Cells(j, count).Value = CStr(result)

End If
j = j + 1

Loop
i = i + 1

Loop

Next

End Sub
[/vba]
 
Ответить
СообщениеЕсть вот такая часть кода просто надо сюда добавить распознание дат и заполнение свода по датам с суммированием данных
[vba]
Код
Sub Результат_по_осям()
Dim avFiles
'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
avFiles = Application.GetOpenFilename _
("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
If VarType(avFiles) = vbBoolean Then
'была нажата кнопка отмены - выход из процедуры
Exit Sub
End If
'avFiles - примет тип String
Dim tab_worker As String
Dim i, j, count, column As Integer
Dim result As Double
Dim flag As Boolean
count = 4
For Each x In avFiles
Workbooks.Open x
i = 6
Dim Name As String
Name = ActiveWorkbook.Name
Do While ActiveWorkbook.Sheets("Свод").Cells(i, 2).Value <> ""
Workbooks(Name).Activate
For k = 4 To 1000

If ActiveWorkbook.Sheets("Свод").Cells(4, k).Value = "Сумма" Then

column = k
k = 1001

End If

Next

result = CDbl(ActiveWorkbook.Sheets("Свод").Cells(i, column).Text)
tab_worker = ActiveWorkbook.Sheets("Свод").Cells(i, 3).Value
Workbooks("Свод по сварки осей.xlsm").Activate
flag = True
j = 3
Do While flag = True

If tab_worker = ActiveWorkbook.Sheets("Свод").Cells(j, 3).Value Then

flag = False
ActiveWorkbook.Sheets("Свод").Cells(j, count).Value = CStr(result)

End If
j = j + 1

Loop
i = i + 1

Loop

Next

End Sub
[/vba]

Автор - Sergey6734
Дата добавления - 15.02.2022 в 16:32
doober Дата: Вторник, 15.02.2022, 17:51 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 886
Репутация: 310 ±
Замечаний: 0% ±

Excel 2010
Жесть.Пример файла наряда есть?


 
Ответить
СообщениеЖесть.Пример файла наряда есть?

Автор - doober
Дата добавления - 15.02.2022 в 17:51
Sergey6734 Дата: Вторник, 15.02.2022, 17:53 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Да есть
К сообщению приложен файл: ___2.xlsm(82.9 Kb)
 
Ответить
СообщениеДа есть

Автор - Sergey6734
Дата добавления - 15.02.2022 в 17:53
doober Дата: Вторник, 15.02.2022, 18:34 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 886
Репутация: 310 ±
Замечаний: 0% ±

Excel 2010
Не практикуйте работу с активными листами, книгами[vba]
Код
Sub Результат_doober()
    Dim avFiles, Sh As Worksheet, key, ShIn As Worksheet
    Set C_rab = CreateObject("scripting.dictionary")
    Set C_is = CreateObject("scripting.dictionary")
    Set Sh = ThisWorkbook.Worksheets("Свод")
    LastRow = Sh.Cells(Sh.Rows.count, "C").End(xlUp).Row
    LastColl = Sh.Cells(2, Sh.Columns.count).End(xlToLeft).column
    hd = Sh.Cells(2, 1).Resize(1, LastColl)
    dx = Sh.Cells(1, 3).Resize(LastRow, 2)
    For n = 3 To UBound(hd, 2)
        key = hd(1, n)
        If IsDate(key) Then
            C_is.Item(CDate(key)) = n
        End If
    Next
    For n = 3 To UBound(dx)
        key = dx(n, 1) & ""
        C_rab.Item(key) = n
    Next
    'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
    avFiles = Application.GetOpenFilename _
              ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        'была нажата кнопка отмены - выход из процедуры
        Exit Sub
    End If
    'avFiles - примет тип String
    Dim i, j
    Application.ScreenUpdating = False
    For Each x In avFiles
        Set ShIn = Workbooks.Open(x).Worksheets(1)
        key = CDate(ShIn.Range("d3"))
        If C_is.Exists(key) Then
            LastRow = ShIn.Cells(Sh.Rows.count, "C").End(xlUp).Row
            dz = ShIn.Range("C1").Resize(LastRow, 2)
            cl = C_is.Item(CDate(key))
            For i = 6 To UBound(dz)
                key = dz(i, 1) & ""
                Sum = dz(i, 2)
                If C_rab.Exists(key) Then
                    rw = C_rab.Item(key)
                    Sh.Cells(rw, cl) = Sh.Cells(rw, cl) + Sum
                End If
            Next
        End If
        ShIn.Parent.Close (False)

    Next
    Application.ScreenUpdating = True
End Sub
[/vba]


 
Ответить
СообщениеНе практикуйте работу с активными листами, книгами[vba]
Код
Sub Результат_doober()
    Dim avFiles, Sh As Worksheet, key, ShIn As Worksheet
    Set C_rab = CreateObject("scripting.dictionary")
    Set C_is = CreateObject("scripting.dictionary")
    Set Sh = ThisWorkbook.Worksheets("Свод")
    LastRow = Sh.Cells(Sh.Rows.count, "C").End(xlUp).Row
    LastColl = Sh.Cells(2, Sh.Columns.count).End(xlToLeft).column
    hd = Sh.Cells(2, 1).Resize(1, LastColl)
    dx = Sh.Cells(1, 3).Resize(LastRow, 2)
    For n = 3 To UBound(hd, 2)
        key = hd(1, n)
        If IsDate(key) Then
            C_is.Item(CDate(key)) = n
        End If
    Next
    For n = 3 To UBound(dx)
        key = dx(n, 1) & ""
        C_rab.Item(key) = n
    Next
    'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
    avFiles = Application.GetOpenFilename _
              ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
    If VarType(avFiles) = vbBoolean Then
        'была нажата кнопка отмены - выход из процедуры
        Exit Sub
    End If
    'avFiles - примет тип String
    Dim i, j
    Application.ScreenUpdating = False
    For Each x In avFiles
        Set ShIn = Workbooks.Open(x).Worksheets(1)
        key = CDate(ShIn.Range("d3"))
        If C_is.Exists(key) Then
            LastRow = ShIn.Cells(Sh.Rows.count, "C").End(xlUp).Row
            dz = ShIn.Range("C1").Resize(LastRow, 2)
            cl = C_is.Item(CDate(key))
            For i = 6 To UBound(dz)
                key = dz(i, 1) & ""
                Sum = dz(i, 2)
                If C_rab.Exists(key) Then
                    rw = C_rab.Item(key)
                    Sh.Cells(rw, cl) = Sh.Cells(rw, cl) + Sum
                End If
            Next
        End If
        ShIn.Parent.Close (False)

    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - doober
Дата добавления - 15.02.2022 в 18:34
Sergey6734 Дата: Вторник, 15.02.2022, 18:50 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Спасибо большое работает
 
Ответить
СообщениеСпасибо большое работает

Автор - Sergey6734
Дата добавления - 15.02.2022 в 18:50
Sergey6734 Дата: Среда, 16.02.2022, 07:06 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Доброе времени суток. А если лист свод не первый и не один, как это прописать?
 
Ответить
СообщениеДоброе времени суток. А если лист свод не первый и не один, как это прописать?

Автор - Sergey6734
Дата добавления - 16.02.2022 в 07:06
doober Дата: Среда, 16.02.2022, 10:07 | Сообщение № 8
Группа: Друзья
Ранг: Ветеран
Сообщений: 886
Репутация: 310 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте[vba]
Код
set wb=Workbooks.Open(x)
    for each ShIn in wb.Worksheets
'  много кода
    next
wb.close(false)
[/vba]


 
Ответить
СообщениеЗдравствуйте[vba]
Код
set wb=Workbooks.Open(x)
    for each ShIn in wb.Worksheets
'  много кода
    next
wb.close(false)
[/vba]

Автор - doober
Дата добавления - 16.02.2022 в 10:07
Sergey6734 Дата: Среда, 16.02.2022, 10:14 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Спасибо
 
Ответить
СообщениеСпасибо

Автор - Sergey6734
Дата добавления - 16.02.2022 в 10:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление данных из нескольких файлов в один файл по дате (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!