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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных в таблицу - Мир MS Excel

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

Excel 2019
Всем доброго времени суток!

Прошу помочь в написании кода для кнопки в файле 01_HR_OPEX_individual_plan. Данная кнопка должна переносить значения по статьям затрат в файл Budget2022_Template.

Например статья IT Hardware (expensed) - 110 000. Должно перенестись 110000 в ячейку R30. Flight expenses/ 3rd/ Remaining - 200 000. 200 000 должно перенестись в ячейку R15 и тд. Нюанс в том, что ячейки могут меняться, поэтому дл соотнесения в таблицу Budget сделана желтая строчка, где название отдела соотносится с названием в файле по плану в ячейке А1. В данном случае это название HR.

Буду рад любой помощи или наводки.
К сообщению приложен файл: Budget2022_Temp.xls(54.0 Kb) · 01_HR_OPEX_indi.xlsx(345.8 Kb)
 
Ответить
СообщениеВсем доброго времени суток!

Прошу помочь в написании кода для кнопки в файле 01_HR_OPEX_individual_plan. Данная кнопка должна переносить значения по статьям затрат в файл Budget2022_Template.

Например статья IT Hardware (expensed) - 110 000. Должно перенестись 110000 в ячейку R30. Flight expenses/ 3rd/ Remaining - 200 000. 200 000 должно перенестись в ячейку R15 и тд. Нюанс в том, что ячейки могут меняться, поэтому дл соотнесения в таблицу Budget сделана желтая строчка, где название отдела соотносится с названием в файле по плану в ячейке А1. В данном случае это название HR.

Буду рад любой помощи или наводки.

Автор - Oh_Nick
Дата добавления - 20.09.2021 в 13:31
Erjoma1981 Дата: Понедельник, 20.09.2021, 22:40 | Сообщение № 2
Группа: Проверенные
Ранг: Участник
Сообщений: 66
Репутация: 25 ±
Замечаний: 0% ±

Excel 2010, 2019
[vba]
Код
Option Explicit
Function НомерПоследнейСтроки(Страница As Worksheet) As LongPtr
    НомерПоследнейСтроки = Страница.UsedRange.Row + Страница.UsedRange.Rows.Count - 1
End Function

Sub ПереносСуммПоСтатьямЗатрат()
    Dim НайденноеЗначение As Range, Ячейка As Range, Отдел As Range, Разделы As Range, ИсходныеРазделы As Range
    Dim АдресПервогоНайденогоЗначения As String, ТекущийКаталог As String
    Dim ЛистСИсходнымиДанными As Worksheet, ИзменяемыйЛист As Worksheet
    
    Application.ScreenUpdating = False
    ТекущийКаталог = ActiveWorkbook.Path
    Set ЛистСИсходнымиДанными = ActiveWorkbook.Sheets("OPEX forms")
    Set ИсходныеРазделы = ЛистСИсходнымиДанными.Range(ЛистСИсходнымиДанными.Cells(3, 7), ЛистСИсходнымиДанными.Cells(НомерПоследнейСтроки(ЛистСИсходнымиДанными), 7))
    
    Workbooks.Open (ТекущийКаталог & "\Budget2022_Temp.xls")
    Set ИзменяемыйЛист = ActiveWorkbook.Sheets("BUDGET 2022 Template")
    Set Разделы = ИзменяемыйЛист.Range(ИзменяемыйЛист.Cells(4, 1), ИзменяемыйЛист.Cells(НомерПоследнейСтроки(ИзменяемыйЛист), 1))
    Set Отдел = ИзменяемыйЛист.Range(ИзменяемыйЛист.Cells(1, 4), ИзменяемыйЛист.Cells(1, 25)).Find(ЛистСИсходнымиДанными.[A1].Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Отдел Is Nothing Then
        MsgBox "Не удалось найти отдел: " & ЛистСИсходнымиДанными.[A1].Value
        Exit Sub
    End If
    
    Set НайденноеЗначение = ИсходныеРазделы.Find("*", LookIn:=xlFormulas)
    If Not НайденноеЗначение Is Nothing Then
        АдресПервогоНайденогоЗначения = НайденноеЗначение.Address
        Do
           For Each Ячейка In Разделы
                If Trim(Ячейка.Value) = НайденноеЗначение.Offset(0, -2).Value Then
                    ИзменяемыйЛист.Cells(Ячейка.Row, Отдел.Column).Value = НайденноеЗначение.Offset(0, -1).Value
                End If
           Next Ячейка
           
           Set НайденноеЗначение = ИсходныеРазделы.Find("*", LookIn:=xlFormulas, After:=НайденноеЗначение)
        Loop While АдресПервогоНайденогоЗначения <> НайденноеЗначение.Address
    End If

    Workbooks("Budget2022_Temp.xls").Close (True)
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 01_HR_OPEX_indi.xlsm(354.9 Kb)
 
Ответить
Сообщение[vba]
Код
Option Explicit
Function НомерПоследнейСтроки(Страница As Worksheet) As LongPtr
    НомерПоследнейСтроки = Страница.UsedRange.Row + Страница.UsedRange.Rows.Count - 1
End Function

Sub ПереносСуммПоСтатьямЗатрат()
    Dim НайденноеЗначение As Range, Ячейка As Range, Отдел As Range, Разделы As Range, ИсходныеРазделы As Range
    Dim АдресПервогоНайденогоЗначения As String, ТекущийКаталог As String
    Dim ЛистСИсходнымиДанными As Worksheet, ИзменяемыйЛист As Worksheet
    
    Application.ScreenUpdating = False
    ТекущийКаталог = ActiveWorkbook.Path
    Set ЛистСИсходнымиДанными = ActiveWorkbook.Sheets("OPEX forms")
    Set ИсходныеРазделы = ЛистСИсходнымиДанными.Range(ЛистСИсходнымиДанными.Cells(3, 7), ЛистСИсходнымиДанными.Cells(НомерПоследнейСтроки(ЛистСИсходнымиДанными), 7))
    
    Workbooks.Open (ТекущийКаталог & "\Budget2022_Temp.xls")
    Set ИзменяемыйЛист = ActiveWorkbook.Sheets("BUDGET 2022 Template")
    Set Разделы = ИзменяемыйЛист.Range(ИзменяемыйЛист.Cells(4, 1), ИзменяемыйЛист.Cells(НомерПоследнейСтроки(ИзменяемыйЛист), 1))
    Set Отдел = ИзменяемыйЛист.Range(ИзменяемыйЛист.Cells(1, 4), ИзменяемыйЛист.Cells(1, 25)).Find(ЛистСИсходнымиДанными.[A1].Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Отдел Is Nothing Then
        MsgBox "Не удалось найти отдел: " & ЛистСИсходнымиДанными.[A1].Value
        Exit Sub
    End If
    
    Set НайденноеЗначение = ИсходныеРазделы.Find("*", LookIn:=xlFormulas)
    If Not НайденноеЗначение Is Nothing Then
        АдресПервогоНайденогоЗначения = НайденноеЗначение.Address
        Do
           For Each Ячейка In Разделы
                If Trim(Ячейка.Value) = НайденноеЗначение.Offset(0, -2).Value Then
                    ИзменяемыйЛист.Cells(Ячейка.Row, Отдел.Column).Value = НайденноеЗначение.Offset(0, -1).Value
                End If
           Next Ячейка
           
           Set НайденноеЗначение = ИсходныеРазделы.Find("*", LookIn:=xlFormulas, After:=НайденноеЗначение)
        Loop While АдресПервогоНайденогоЗначения <> НайденноеЗначение.Address
    End If

    Workbooks("Budget2022_Temp.xls").Close (True)
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Erjoma1981
Дата добавления - 20.09.2021 в 22:40
Oh_Nick Дата: Вторник, 21.09.2021, 09:31 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 228
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Erjoma1981,

Спасибо! Доработаю дальше под себя
 
Ответить
СообщениеErjoma1981,

Спасибо! Доработаю дальше под себя

Автор - Oh_Nick
Дата добавления - 21.09.2021 в 09:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных в таблицу (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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