Как повторно использовать код VBA (подпункт) в нескольких других подпрограммах - PullRequest
Новая
       1

Как повторно использовать код VBA (подпункт) в нескольких других подпрограммах

0 голосов
/ 18 октября 2018

У меня есть 50 wb, которые я сейчас обновляю, используя vba.Но это перетаскивание (и обновление) одного и того же кода 50 раз, поэтому я пытаюсь найти метод для повторного использования кода.Все wb одинаковы по структуре (имена листов и т. Д.), И поэтому базовый «update-vba» должен многократно использоваться во всех «UpdateGroup-subs».Моя идея состоит в том, чтобы поместить определения и базовую «update-vba» в подпрограммы вне «UpdateGroup-subs» и вызывать их при запуске каждой «UpdateGroup-sub».Но я получаю ошибку компиляции (переменная не определена).Возможно ли то, что я пытаюсь сделать?Кто-нибудь, кто может помочь мне, как заставить это работать?Я загружаю 2 версии, одна из которых работает (повторяет весь код в каждом "UpdateGroup-sub"), а другая - моя попытка упростить это ...

РАБОТЫ: 

Option Explicit
'************************************************************************

Sub UpdateAllGroups_1_WorksOK()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup1
    Call UpdateGroup2

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub UpdateGroup1()

'DEFINITIONS
Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\Group1_(M).xlsm")    'must be changed in each UpdateGroup-sub
    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

ThisGroupWb = "Group1_(M).xlsm"     'must be changed in each UpdateGroup-sub
ReportR2ob = "R2ob - Group1.xls"    'must be changed in each UpdateGroup-sub
ReportR1vo = "R1vo - Group1.xls"    'must be changed in each UpdateGroup-sub
ReportR2vo = "R2vo - Group1.xls"    'must be changed in each UpdateGroup-sub


'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

Private Sub UpdateGroup2()

'DEFINITIONS
Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\Group2_(M).xlsm")    'must be changed in each UpdateGroup-sub
    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

ThisGroupWb = "Group2_(M).xlsm"     'must be changed in each UpdateGroup-sub
ReportR2ob = "R2ob - Group2.xls"    'must be changed in each UpdateGroup-sub
ReportR1vo = "R1vo - Group2.xls"    'must be changed in each UpdateGroup-sub
ReportR2vo = "R2vo - Group2.xls"    'must be changed in each UpdateGroup-sub


'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

НЕ РАБОТАЕТ: 

Option Explicit
'************************************************************************

Sub UpdateAllGroups_2_DoesntWork()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup1
    Call UpdateGroup2

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub Definitions()

Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
Dim WbReport, WbGroup As Workbook
Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

    fPath = ThisWorkbook.Path
        If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
        End If

    With WbGroup
        Set sh_Dash = .Worksheets("Dash")
        Set sh_NewR2ob = .Worksheets("NewR2ob")
        Set sh_NewR1vo = .Worksheets("NewR1vo")
        Set sh_NewR2vo = .Worksheets("NewR2vo")
        Set sh_Time = .Worksheets("Time")
    End With

End Sub
'************************************************************************

Private Sub UpdateGroups()

Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\ThisGroupWb")

'NEW REPORTS
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
    WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
    WbReport.Close False

    Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
    WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
    WbReport.Close False


'STORE AND CLOSE GROUP-WB
Application.Goto sh_Dash.Range("A1"), True
WbGroup.Save
WbGroup.Close False

End Sub
'************************************************************************

Private Sub UpdateGroup1()

Call Definitions
    ThisGroupWb = "Group1_(M).xlsm"
    ReportR2ob = "R2ob - Group1.xls"
    ReportR1vo = "R1vo - Group1.xls"
    ReportR2vo = "R2vo - Group1.xls"
Call UpdateGroups

End Sub
'************************************************************************

Private Sub UpdateGroup2()

Call Definitions
    ThisGroupWb = "Group2_(M).xlsm"
    ReportR2ob = "R2ob - Group2.xls"
    ReportR1vo = "R1vo - Group2.xls"
    ReportR2vo = "R2vo - Group2.xls"
Call UpdateGroups

End Sub

1 Ответ

0 голосов
/ 18 октября 2018

Вы должны использовать аргументы в своей подпрограмме следующим образом: 

'Version 1: using single argument GroupNumber

Option Explicit
'************************************************************************

Sub UpdateAllGroups()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup(1)
    Call UpdateGroup(2)

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub UpdateGroup(ByVal GroupNumber As Long)

    'DEFINITIONS
    Dim fPath, ThisGroupWb, ReportR2ob, ReportR1vo, ReportR2vo As String
    Dim WbReport, WbGroup As Workbook
    Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

        fPath = ThisWorkbook.Path
            If Right(fPath, 1) = "\" Then
            fPath = Left(fPath, Len(fPath) - 1)
            End If

    'Note that path is composed using supplied argument:
    Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\Group" & GroupNumber & "_(M).xlsm")
        With WbGroup
            Set sh_Dash = .Worksheets("Dash")
            Set sh_NewR2ob = .Worksheets("NewR2ob")
            Set sh_NewR1vo = .Worksheets("NewR1vo")
            Set sh_NewR2vo = .Worksheets("NewR2vo")
            Set sh_Time = .Worksheets("Time")
        End With

    'Same here:
    ThisGroupWb = "Group" & GroupNumber & "_(M).xlsm"     'must be changed in each UpdateGroup-sub
    ReportR2ob = "R2ob - Group" & GroupNumber & ".xls"    'must be changed in each UpdateGroup-sub
    ReportR1vo = "R1vo - Group" & GroupNumber & ".xls"    'must be changed in each UpdateGroup-sub
    ReportR2vo = "R2vo - Group" & GroupNumber & ".xls"    'must be changed in each UpdateGroup-sub


    'NEW REPORTS
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

        Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
        WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
        WbReport.Close False

        Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
        WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
        WbReport.Close False

        Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
        WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
        WbReport.Close False


    'STORE AND CLOSE GROUP-WB
    Application.Goto sh_Dash.Range("A1"), True
    WbGroup.Save
    WbGroup.Close False

End Sub

Или, ближе к тому, что вы сделали: 

'Version 2: using ThisGroupWb, ReportR2ob, ReportR1vo and ReportR2vo

Option Explicit
'************************************************************************

Sub UpdateAllGroups()

Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

    Call UpdateGroup("Group1_(M).xlsm", "R2ob - Group1.xls", "R1vo - Group1.xls", "R2vo - Group1.xls")
    Call UpdateGroup("Group2_(M).xlsm", "R2ob - Group2.xls", "R1vo - Group2.xls", "R2vo - Group2.xls")

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "All Updates is done in " & MinutesElapsed, vbInformation, "Message"

End Sub
'************************************************************************

Private Sub UpdateGroup(ByVal ThisGroupWb As String, ByVal ReportR2ob As String, ByVal ReportR1vo As String, ByVal ReportR2vo As String)

    'DEFINITIONS
    Dim fPath As String
    Dim WbReport, WbGroup As Workbook
    Dim sh_Dash, sh_NewR2ob, sh_NewR1vo, sh_NewR2vo, sh_Time As Worksheet

        fPath = ThisWorkbook.Path
            If Right(fPath, 1) = "\" Then
            fPath = Left(fPath, Len(fPath) - 1)
            End If

    Set WbGroup = Workbooks.Open(ThisWorkbook.Path & "\" & ThisGroupWb)    'must be changed in each UpdateGroup-sub
        With WbGroup
            Set sh_Dash = .Worksheets("Dash")
            Set sh_NewR2ob = .Worksheets("NewR2ob")
            Set sh_NewR1vo = .Worksheets("NewR1vo")
            Set sh_NewR2vo = .Worksheets("NewR2vo")
            Set sh_Time = .Worksheets("Time")
        End With

    'Already assigned (call arguments)
    'ThisGroupWb = ...
    'ReportR2ob = ...
    'ReportR1vo = ...
    'ReportR2vo = ...


    'NEW REPORTS
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

        Set WbReport = Workbooks.Open(fPath & "\R2ob\" & ReportR2ob)
        WbReport.Sheets(1).Cells.Copy sh_NewR2ob.Range("A1")
        WbReport.Close False

        Set WbReport = Workbooks.Open(fPath & "\R1vo\" & ReportR1vo)
        WbReport.Sheets(1).Cells.Copy sh_NewR2vo.Range("A1")
        WbReport.Close False

        Set WbReport = Workbooks.Open(fPath & "\R2vo\" & ReportR2vo)
        WbReport.Sheets(1).Cells.Copy sh_NewR1vo.Range("A1")
        WbReport.Close False


    'STORE AND CLOSE GROUP-WB
    Application.Goto sh_Dash.Range("A1"), True
    WbGroup.Save
    WbGroup.Close False

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...