在Excel中使用VBA自动生成月度报表

我在这方面工作了一段时间，现在遇到了麻烦

目标：在将数据放入报告之前，将自动生成的每日数据（生成过程已经运行良好）转换为月度和季度回报（其他因素，如夏普比率也将实施）。该报告将每天自动上传到网站。（看看factshee）

问题是：在将数据复制到factsheet时，我无法使复制和粘贴过程自动化。问题是（我认为）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

下面是我粘贴值的代码（不知道如何自动执行）

辅助图片

非常感谢你

如果方便的话，我可以直接通过电子邮件将文件发送给其他人：）

---

（编辑：修复了最终代码格式，因为列表后的代码会产生SO效应）

这不是一个真正的解决方案（稍后将删除），但更多的是关于如何调整代码（并大大缩短代码）的示例

虽然这不是一个解决方案，但您可以调整下面使用的方法，使代码更干净，更容易理解。在调试时，可读性很重要。阅读无用的行（例如带有

.Select

）的行）不会帮助您找到根本问题

您需要使用包含所复制数据的工作表名称更新

Set WS=thiswoolk.Sheets（“Sheet1”）

。排位赛的范围总是很好的实践，所以你知道你的范围在哪里是没有问题的（活动表，表（n），另一本书？）

---

很抱歉出现错误：（（您应该避免使用

。选择
方法。无需激活单元格、区域、工作表或工作簿即可修改其值、复制或删除某些内容。
 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

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