Запуск макроса в одном файле Excel из другого файла Excel - PullRequest
Новая
       38

Запуск макроса в одном файле Excel из другого файла Excel

0 голосов
/ 07 февраля 2019

Я пишу макрос в одном из файлов Excel.Я хочу запустить это из другого листа Excel.

Мой код: 

Sub Full_Automation()
    Dim All_Submitted_Dates As Variant
    Dim All_WorkWeek As Variant
    Dim dctUnique_WorkWeek As Dictionary
    Dim DateCounter As Long
    Dim WorkWeekCounter As Long

    Sheet1.Activate
    Set dctUnique_WorkWeek = New Dictionary

With Sheet1
    All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With

    WorkWeekCounter = 1

For DateCounter = 1 To UBound(All_Submitted_Dates)
    If Not dctUnique_WorkWeek.Exists("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) Then
        dctUnique_WorkWeek.Add Key:="WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter)), Item:=1
    Else
        dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1
    End If
Next DateCounter

    Worksheets.Add after:=Sheets(Sheets.Count)
    Worksheets(3).Activate


    Dim rowCounter As Long
    Dim varKey As Variant

    rowCounter = 2


    For Each varKey In dctUnique_WorkWeek.Keys()
        Range("A" & rowCounter).Value = varKey
        Range("D" & rowCounter).Value = dctUnique_WorkWeek(varKey)

        If rowCounter = 2 Then
            Range("C" & rowCounter).Formula = "=B" & rowCounter
            Range("E" & rowCounter).Formula = "=D" & rowCounter
        Else
            Range("C" & rowCounter).Formula = "=C" & (rowCounter - 1) & "+B" & rowCounter
            Range("E" & rowCounter).Formula = "=E" & (rowCounter - 1) & "+D" & rowCounter
        End If
        rowCounter = rowCounter + 1
    Next

End Sub

Когда я пытался отладить код построчно, я узнал, что всякий раз, когда я выполняю строку Sheet1.Activate, она идет в исходный файл Excel, гдемой макрос присутствует.Как я буду ссылаться на первый лист другой книги?

Ответы [ 2 ]

0 голосов
/ 07 февраля 2019

Раннее связывание может загрузить объект словаря в исходном объявлении. 

Set dctUnique_WorkWeek = New Dictionary

Это создает одномерный массив, но вы начинаете приращение в For ... Next с 1, а не с нуля.Вероятно, лучше просто использовать двумерный массив.На самом деле, целесообразно всегда использовать LBound to UBound для For ... Next с массивом. 

With Sheet1
    All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With

Кодовое имя Sheet1 будет ссылаться на Sheet1 в рабочей книге, содержащей VBA.проект.Используйте имя рабочего листа и предоставьте явную родительскую рабочую книгу, если она внешняя. 

Sheet1.Activate

Фактически, нет необходимости. Активировать рабочую таблицу, чтобы ссылаться на нее, если предоставляется явно указанная родительская рабочая книга. 

dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1

a) Формат VBA использует маску формата ww , чтобы получить тот же номер, что и WorksheetFunction.WeekNum.b) Существует сокращенное обозначение «показатель в словаре», которое обходит метод словаря Exists.

WorkWeekCounter , по-видимому, не используется после его объявления и ему присваивается значение 1. 

WorkWeekCounter = 1

Вы можете написать все ключи и предметы одновременно.Формулы потребуют 2 шага из-за различных формул. 

For Each varKey In dctUnique_WorkWeek.Keys()

Ваши формулы, кажется, ссылаются на столбец B, но никакие значения не помещаются в столбец B на новом листе. 

Option Explicit

Sub Full_Automation()

    Dim All_Submitted_Dates As Variant, dctUnique_WorkWeek As New Dictionary
    Dim dc As Long

    With ActiveWorkbook  'better as With Workbooks("Book1.xlsx")

        With .Worksheets("Sheet1")
            All_Submitted_Dates = .Range(.Cells(2, "K"), .Cells(.Rows.Count, "K").End(xlUp)).Value2
        End With

        For dc = LBound(All_Submitted_Dates, 1) To UBound(All_Submitted_Dates, 1)
            dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) = _
                dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) + 1
        Next dc

        Worksheets.Add After:=.Sheets(.Sheets.Count)

        With .Sheets(.Sheets.Count)

            'name = "give the new worksheet a name"

            .Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.keys)
            .Cells(2, "D").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.items)

            'optionally sort the weeks
            With .Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 4)
                .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
            End With

            .Cells(2, "C").Formula = "=B2"
            .Cells(2, "E").Formula = "=D2"

            .Range(.Cells(3, "C"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2)).Formula = "=C2+B3"
            .Range(.Cells(3, "E"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 4)).Formula = "=E2+D3"

        End With

    End With

End Sub
0 голосов
/ 07 февраля 2019

Коллекция Sheets является свойством объекта Workbook (обратите внимание, что коллекция Sheets является более инклюзивной, чем коллекция worksheets, поскольку не все Sheets являются Worksheets).Рабочая книга по умолчанию - ActiveWorkbook, и она будет решена, если вы не укажете ничего другого.

Вы можете назначить рабочую книгу переменной, объявленной как Workbook. 

Dim Wb As Workbook
Set Wb = ThisWorkbook
or 
Set Wb = ActiveWorkbook
or
Set Wb = Workbooks.Open ([File name])
or
Set Wb = Workbooks.Add ([Template])

Затем вы можете обратиться к любому листу в назначенной книге. 

Debug.Print Wb.Worksheets("Sheet1").Cells(1, 1).Value
...