文档建议反馈控制台
首页
学习
活动
专区
圈层
工具
MCP广场
文章/答案/技术大牛
发布
社区首页 >问答首页 >在Excel中使用VBA自动生成月度退货报表

问在Excel中使用VBA自动生成月度退货报表
EN

Stack Overflow用户
提问于 2018-07-06 00:13:20
回答 1查看 467关注 0票数 0

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

目标:获取自动生成的每日数据(生成过程已经运行良好)，并将其转换为月度和季度回报(也将实现夏普比率等其他因素)，然后将数据放入报告。该报告将每天自动上载到网站。(请看factshee)

问题:当将数据复制到factsheet上时，我无法使复制和粘贴过程自动化。问题(我认为)是excel将我的空白单元格视为值，不能正确识别列中的最后一个单元格。(请参阅月度报税表)。

My Skeleton/Steps to Automation: 1.建立“删除行”列(删除第一个交易日和最后一个交易日之间的天数) 2.计算月度收益3.清理单元格以准备粘贴到factsheet/report 4.复制并粘贴值

我尝试过的: 1.这是我准备复制和粘贴的代码

代码语言：javascript
复制
    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

下面是我粘贴这些值的代码(不知道如何实现自动化)。

代码语言：javascript
复制
 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效果而导致的最终代码格式)

vba
excel
automation
report
finance
EN

回答 1

Stack Overflow用户

发布于 2018-07-06 00:44:02

这并不是一个真正的解决方案(稍后会删除)，而更多的是如何使代码适应(并大大缩短) to avoid the .Select method的示例。

虽然这不是一个解决方案，但您可以调整下面使用的方法，使您的代码更简洁、更容易理解。当涉及到调试时，可靠性很重要。通读无用的代码行(比如带有.Select的代码行)并不能帮助您找到根本问题！

您需要使用包含要复制的数据的工作表名称来更新Set WS = ThisWorkbook.Sheets("Sheet1")。限定范围总是很好的实践，所以你知道你的范围在哪里是没有问题的(活动工作表，工作表(N)，另一本书？)。

代码语言：javascript
复制
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
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：

https://stackoverflow.com/questions/51195894

复制
相关文章

相似问题

领券

腾讯云开发者

扫码关注腾讯云开发者

扫码关注腾讯云开发者

领取腾讯云代金券

热门产品

热门推荐

更多推荐

Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 粤公网安备44030502008569号

腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号

问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档