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

Вход

Регистрация

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

 

= Мир MS Excel/оптимизация макроса по копированию данных из разных книг - Мир MS Excel

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

Приветствую, дорогие форумчане.
При написании программы проведения соревнований, создал макрос, который будет очень большим, что прибавит много рутинной работы.
Суть такая: Книга А (макет с таблицами для разного количества участников), Книга Б (протокол взвешивания участников), Книга В (турнирная сетка).
Мой макрос копирует определенный лист из Книги А (в зависимости от участников взвешивания в Книге Б) в Книгу В.
Как его можно оптимизировать, чтобы он стал максимально короче?
Спасибо.

[vba]
Код
Sub ê8()
'
' ê8 Ìàêðîñ
'

Sub ()
    
    If ActiveSheet.Range("C101") = 8 Then
    Windows("Книга А.xlsm").Activate
    Sheets("8").Select     '[color=green]  макет для 8 участников
    Sheets("8").Copy After:=Workbooks(Книга В..xlsm").ActiveSheet
    Windows(Книга Б..xlsm").Activate
    Range("B3:F314").Select
    Selection.Copy
    Windows("Книга В.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Книга Б..xlsm").Activate
    Range("A2:S2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(Книга В..xlsm").Activate
    Range("A2:S2").Select
    ActiveSheet.Paste

    ElseIf ActiveSheet.Range("C101") = 9 Then
    Windows("Книга А.xlsm").Activate
    Sheets("9").Select    '[color=green] макет для 8 участников
    Sheets("9").Copy After:=Workbooks(Книга В..xlsm").ActiveSheet
    Windows(Книга Б..xlsm").Activate
    Range("B3:F314").Select
    Selection.Copy
    Windows("Книга В.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Книга Б..xlsm").Activate
    Range("A2:S2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(Книга В..xlsm").Activate
    Range("A2:S2").Select
    ActiveSheet.Paste

        End If
и т.д.
end Sub
[/vba]
К сообщению приложен файл: 4206750.xls(260.0 Kb) · 9953371.xls(114.0 Kb) · 3840739.xls(442.0 Kb)
 
Ответить
СообщениеПриветствую, дорогие форумчане.
При написании программы проведения соревнований, создал макрос, который будет очень большим, что прибавит много рутинной работы.
Суть такая: Книга А (макет с таблицами для разного количества участников), Книга Б (протокол взвешивания участников), Книга В (турнирная сетка).
Мой макрос копирует определенный лист из Книги А (в зависимости от участников взвешивания в Книге Б) в Книгу В.
Как его можно оптимизировать, чтобы он стал максимально короче?
Спасибо.

[vba]
Код
Sub ê8()
'
' ê8 Ìàêðîñ
'

Sub ()
    
    If ActiveSheet.Range("C101") = 8 Then
    Windows("Книга А.xlsm").Activate
    Sheets("8").Select     '[color=green]  макет для 8 участников
    Sheets("8").Copy After:=Workbooks(Книга В..xlsm").ActiveSheet
    Windows(Книга Б..xlsm").Activate
    Range("B3:F314").Select
    Selection.Copy
    Windows("Книга В.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Книга Б..xlsm").Activate
    Range("A2:S2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(Книга В..xlsm").Activate
    Range("A2:S2").Select
    ActiveSheet.Paste

    ElseIf ActiveSheet.Range("C101") = 9 Then
    Windows("Книга А.xlsm").Activate
    Sheets("9").Select    '[color=green] макет для 8 участников
    Sheets("9").Copy After:=Workbooks(Книга В..xlsm").ActiveSheet
    Windows(Книга Б..xlsm").Activate
    Range("B3:F314").Select
    Selection.Copy
    Windows("Книга В.xlsm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Книга Б..xlsm").Activate
    Range("A2:S2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(Книга В..xlsm").Activate
    Range("A2:S2").Select
    ActiveSheet.Paste

        End If
и т.д.
end Sub
[/vba]

Автор - amaksimus85
Дата добавления - 13.07.2022 в 09:10
RAN Дата: Среда, 13.07.2022, 11:07 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5640
Репутация: 1145 ±
Замечаний: 0% ±

2010
Макрос можно поместить в любую книгу, но запускать ОБЯЗАТЕЛЬНО с листа "протокол взвешивания"
[vba]
Код
Sub Мяу()
    Dim wbM As Workbook, wbS As Workbook
    Dim sh As Worksheet, shS As Worksheet
    Dim k&

    Set wbM = Workbooks("3840739.xls")    '("Матрица.xlsm")
    Set wbS = Workbooks("4206750.xls")    '("экс.сор..xlsm")
    Set sh = ActiveSheet
    With sh
        k = WorksheetFunction.CountA(Range("D7:D300"))
        'k = .Range("C101").Value
        If k = 8 Then
            wbM.Sheets("8 участников").Copy After:=wbS.ActiveSheet
        ElseIf k = 9 Then
            wbM.Sheets("9уч").Copy After:=wbS.ActiveSheet
            ' добавить по вкусу
            '    ElseIf k = 100 Then
            'wbM.Sheets("100 участников").Copy After:=wbS.ActiveSheet
        End If
        Set shS = ActiveSheet
        shS.Range("B3").Value = .Range("B3").Value
        shS.Range("A2").Value = .Range("A2").Value
        shS.Range("B7:F" & 6 + k * 2).Value = .Range("B7:F" & 6 + k * 2).Value
    End With
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеМакрос можно поместить в любую книгу, но запускать ОБЯЗАТЕЛЬНО с листа "протокол взвешивания"
[vba]
Код
Sub Мяу()
    Dim wbM As Workbook, wbS As Workbook
    Dim sh As Worksheet, shS As Worksheet
    Dim k&

    Set wbM = Workbooks("3840739.xls")    '("Матрица.xlsm")
    Set wbS = Workbooks("4206750.xls")    '("экс.сор..xlsm")
    Set sh = ActiveSheet
    With sh
        k = WorksheetFunction.CountA(Range("D7:D300"))
        'k = .Range("C101").Value
        If k = 8 Then
            wbM.Sheets("8 участников").Copy After:=wbS.ActiveSheet
        ElseIf k = 9 Then
            wbM.Sheets("9уч").Copy After:=wbS.ActiveSheet
            ' добавить по вкусу
            '    ElseIf k = 100 Then
            'wbM.Sheets("100 участников").Copy After:=wbS.ActiveSheet
        End If
        Set shS = ActiveSheet
        shS.Range("B3").Value = .Range("B3").Value
        shS.Range("A2").Value = .Range("A2").Value
        shS.Range("B7:F" & 6 + k * 2).Value = .Range("B7:F" & 6 + k * 2).Value
    End With
End Sub
[/vba]

Автор - RAN
Дата добавления - 13.07.2022 в 11:07
amaksimus85 Дата: Среда, 13.07.2022, 21:36 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

RAN, Спасибо большое!!!! Все получилось
 
Ответить
СообщениеRAN, Спасибо большое!!!! Все получилось

Автор - amaksimus85
Дата добавления - 13.07.2022 в 21:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » оптимизация макроса по копированию данных из разных книг (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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