Автоматизация ежемесячного отчета о доходах с использованием VBA в Excel - PullRequest
Новая
       11

Автоматизация ежемесячного отчета о доходах с использованием VBA в Excel

0 голосов
/ 05 июля 2018

Я работал над этим некоторое время и врезался в стену.

Цель: принести ежедневные данные, которые автоматически генерируются (процесс генерации уже работает нормально), и преобразовать их в ежемесячную и квартальную доходность (также будут реализованы другие факторы, такие как коэффициент Шарпа), прежде чем помещать данные в отчет. Отчет будет автоматически загружаться ежедневно на веб-сайт. (Посмотрите на факты)

Проблема: При копировании данных в информационный лист я не могу автоматизировать процесс копирования и вставки. Проблема (я думаю) заключается в том, что Excel просматривает мои пустые ячейки как значения и не может правильно определить последнюю ячейку в столбце. (Смотрите лист ежемесячных отчетов).

Мой скелет / Шаги к автоматизации: 1. Установите столбец «Удалить строки» (сделайте это, чтобы избавиться от дней между первым торговым днем ​​и последним торговым днем) 2. Рассчитать ежемесячные доходы 3. Очистите ячейки, чтобы подготовиться к вставке в информационный листок / отчет 4. Скопируйте и вставьте значения

Что я пробовал: 1. Вот мой код для подготовки к копированию и вставке 

    Sub Monthly_Returns_new_ws2()
    Range("A4:Y4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Monthly_Returns").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ' Disable certain Excel features, whilst the macro is running
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False

        ' Declare variables
        Dim deleteRow As Long
        Dim ws As Worksheet

        'Set objects
        Set ws = ActiveSheet

            'Loop through the rows of data, in order to delte rows with a
            'zero value in column AA. Our data commences of row 4
            For deleteRow = ws.Range("Y" & Rows.Count).End(xlUp).Row To 4 Step -1

                ' Identify values in col AA, which are zero & delete entire row
                If ws.Range("Y" & deleteRow).Value = 0 Then
                    Rows(deleteRow).EntireRow.Delete
                End If

            'Move to next cell in the range which is being looped
            Next deleteRow

        'Re-enable the above Excel features, where were disabled whilst the macro ran
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
Range("AA5:BC5").Select
    Selection.AutoFill Destination:=Range("AA5:BC500"), Type:=xlFillDefault
    Range("AA5:BC500").Select
    ActiveWindow.ScrollRow = 481
    ActiveWindow.ScrollRow = 478
    ActiveWindow.ScrollRow = 473
    ActiveWindow.ScrollRow = 468
    ActiveWindow.ScrollRow = 452
    ActiveWindow.ScrollRow = 443
    ActiveWindow.ScrollRow = 422
    ActiveWindow.ScrollRow = 408
    ActiveWindow.ScrollRow = 346
    ActiveWindow.ScrollRow = 336
    ActiveWindow.ScrollRow = 305
    ActiveWindow.ScrollRow = 263
    ActiveWindow.ScrollRow = 216
    ActiveWindow.ScrollRow = 203
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 176
    ActiveWindow.ScrollRow = 168
    ActiveWindow.ScrollRow = 164
    ActiveWindow.ScrollRow = 156
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 134
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 105
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    Range("Z1").Select

'.........
    Range("AU3:BC3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BE3").Select

Вот мой код для вставки значений (не могу понять, как автоматизировать). 

 Sub Copytofactsheet()
Range("AW73:BZ88").Select
Selection.ClearContents
Range("AW87:BE88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[13]"
Range("AW85:BE86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[13]"
Range("AW83:BE84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[13]"
Range("AW81:BE82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[13]"
Range("AW79:BE80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[13]"
Range("AW77:BE78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[13]"
Range("AW75:BE76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[13]"
Range("AW73:BE74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[13]"
Range("BF87:BP88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[6]"
Range("BF85:BP86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[6]"
Range("BF83:BP84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[6]"
Range("BF81:BP82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[6]"
Range("BF79:BP80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[6]"
Range("BF79:BP80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[6]"
Range("BF79:BP80").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[6]"
Range("BF77:BP78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[6]"
Range("BF75:BP76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[6]"
Range("BF73:BP74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[6]"
Range("BQ87:BZ88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[-4]"
Range("BQ85:BZ86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[-4]"
Range("BQ83:BZ84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[-4]"
Range("BQ81:BZ82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[-4]"
Range("BQ79:BZ80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[-4]"
Range("BQ77:BZ78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[-4]"
Range("BQ75:BZ76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[-4]"
Range("BQ73:BZ74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[-4]"
Range("AW73:BZ88").Select
Range("BQ87").Activate
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"
Selection.NumberFormat = "0.00"
Range("CD56").Select

Поддержка изображений

Большое спасибо,

Я могу отправить кому-то файл напрямую, если это будет проще:)

(Редактировать: исправлен окончательный формат кода из-за эффекта SO в отношении кода, следующего за списком)

1 Ответ

0 голосов
/ 05 июля 2018

Это на самом деле не решение (будет удалено позже), а скорее пример того, как ваш код может быть адаптирован (и значительно сокращен) , чтобы избежать .Select метода .

Хотя это не решение, вы можете адаптировать методы, используемые ниже, чтобы сделать ваш код чище и легче следовать. Готовность важна, когда дело доходит до отладки. Чтение бесполезных строк (например, строк с .Select) не поможет вам найти проблемы с корнем!

Вам необходимо обновить Set WS = ThisWorkbook.Sheets("Sheet1"), указав имя листа, в котором хранятся данные, которые копируются. Отборочные диапазоны - это всегда хорошая практика, так что вы не знаете, где находится ваш диапазон ( активный лист, лист (n), другая книга? ). 

Option Explicit

Sub Monthly_Returns_new_ws2()

Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("Sheet1")
Dim MR As Worksheet: Set MR = ThisWorkbook.Sheets("Monthly_Returns")

Dim CopyRange As Range
Set CopyRange = WS.Range("A4:Y" & WS.Range("Y" & WS.Rows.Count).End(xlUp).Row)
    CopyRange.Copy
    MR.Range("A4").PasteSpecial xlPasteValues

Dim i As Long

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

    For i = WS.Range("Y" & Rows.Count).End(xlUp).Row To 4 Step -1
        If WS.Range("Y" & i).Value = 0 Then Rows(i).EntireRow.Delete
    Next i

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

MR.Range("AA5:BC5").AutoFill Destination:=MR.Range("AA5:BC500"), Type:=xlFillDefault

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

Похожие темы

...